Добрый день. Прошу помочь в создании кода макроса на сводную таблицу чтобы диапазон строк таблицы определялся автоматически и название файла (книги ) тоже.При создании макроса путем автозаписи получается следующий код: ("ведомость1" и "R14C14" могут меняться при открытии новой ведомости)
Код
Sub 111()
ActiveSheet.Range("A8").CurrentRegion.Select 'выделяет всю таблицу с ячейки "A8"
Sheets.Add 'создает сводную таблицу на новом листе
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"ведомость1!R8C1:R14C14", Version:=xlPivotTableVersion14). _
CreatePivotTable TableDestination:="Лист1!R3C1", TableName:= _
"СводнаяТаблица1", DefaultVersion:=xlPivotTableVersion14
Sheets("Лист1").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("год")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("месяц")
.Orientation = xlColumnField
.Position = 2
End With
With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("валюта2")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("% СТАВКА НА ДАТУ " _
)
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("СводнаяТаблица1").AddDataField ActiveSheet.PivotTables _
("СводнаяТаблица1").PivotFields("ОСТАТОК НА ДАТУ (ЭКВИВАЛЕНТ.)"), _
"Сумма по полю ОСТАТОК НА ДАТУ (ЭКВИВАЛЕНТ.)", xlSum
ActiveWindow.Zoom = 80 'именьшает ZOOM сводной таблицы до 80%
End Sub
Sub pt_creator()
Dim wsh As Worksheet
Dim new_wsh As New Worksheet
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim prange As Range
' определяем источник и адрес назначения
Set wsh = Worksheets("ведомость1")
Set prange = wsh.Cells(8, 1).CurrentRegion
Set new_wsh = Sheets.Add
Set ptCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=prange)
Set pt = ptCache.CreatePivotTable(TableDestination:=new_wsh.Cells(3, 1), TableName:="СводнаяТаблица2")
'придаём сводной таблице стандартный вид
pt.InGridDropZones = False
pt.TableStyle2 = "PivotStyleLight16"
'устанавливаем столбцы и строки сводной таблицы
With pt.PivotFields("год")
.Orientation = xlColumnField
.Position = 1
End With
With pt.PivotFields("месяц")
.Orientation = xlColumnField
.Position = 2
End With
With pt.PivotFields("валюта2")
.Orientation = xlRowField
.Position = 1
End With
With pt.PivotFields("% СТАВКА НА ДАТУ ")
.Orientation = xlRowField
.Position = 2
End With
pt.AddDataField pt.PivotFields("ОСТАТОК НА ДАТУ (ЭКВИВАЛЕНТ.)"), _
"Сумма по полю ОСТАТОК НА ДАТУ (ЭКВИВАЛЕНТ.)", xlSum
ActiveWindow.Zoom = 80 'именьшает ZOOM сводной таблицы до 80%
End Sub
Ребят, еще вопрос, косаемый сводной таблицы: как в макросе прописать, чтобы он выделил ячейку столбца верхней или нижней жирной границей если значение ячейки больше или меньше 0.75 например
Dim c
Dim pt_table As Range
Set pt_table = pt.TableRange1.Offset(3, 0).Resize(pt.TableRange1.Rows.Count - 3, pt.TableRange1.Columns.Count)
pt_table.Select
For Each c In pt_table.Columns(11).Cells
If c > 0.75 Then
With c.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = -11489280
.TintAndShade = 0
.Weight = xlThick
End With
End If
Next
No crime is so great as daring to Excel. (Winston Churchill)
Maruf большое спасибо!!! Воспользовался вашим кодом макроса для создания сводной таблицы с динамическим диапазоном. Очень помогло, облазил весь интернет !!!