Вставить сводную таблицу из VBA

Question

Я часами пытаюсь создать сводную таблицу из VBA. Я пробовал разные коды, но получаю ошибки. Следующий код не создает сводную таблицу, он только создает новый лист. У меня есть лист под названием «База», где все мои данные. Имеет 18288 строк и 13 столбцов с данными. Может кто-нибудь помочь мне с тем, почему код не работает для меня

Sub pivottable()

Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As pivottable
Dim PRange As range
Dim LastRow As Long
Dim LastCol As Long
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Base")


LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTable")

Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")


Sheets("PivotTable").Select


With ActiveSheet.PivotTables("PivotTable").PivotFields("FACULTY_ID")
    .Orientation = xlRowField
    .Position = 1
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("PROGRAM_TYPE_NAME")
    .Orientation = xlRowField
    .Position = 2
End With
ActiveSheet.PivotTables("PivotTable").AddDataField ActiveSheet.PivotTables( _
    "PivotTable").PivotFields("PROGRAM_TYPE_LETTER"), "Sum of amount", xlSum



End Sub

Answer 1

Это может работать для вас:

Sub pivottable()

Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As pivottable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim new_sheet As Worksheet

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Application.DisplayAlerts = True
On Error GoTo 0

new_sheet_name = "PivotTable"
pivot_table_name = "pivot_name_here"

Set new_sheet = Sheets.Add(Before:=ActiveSheet)

With new_sheet
.Name = new_sheet_name
End With

Set PSheet = new_sheet
Set DSheet = Worksheets("Base")

LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

Set PCache = ActiveWorkbook.PivotCaches.Create( _
            SourceType:=xlDatabase, _
            SourceData:=PRange.Address(, , xlR1C1))

Set PTable = PCache.CreatePivotTable _
            (TableDestination:=PSheet.Cells(1, 1).Address(, , xlR1C1), TableName:=pivot_table_name)

With PTable.PivotFields("FACULTY_ID")
    .Orientation = xlRowField
    .Position = 1
End With

With PTable.PivotFields("PROGRAM_TYPE_NAME")
    .Orientation = xlRowField
    .Position = 2
End With

With PTable
    .AddDataField ActiveSheet.PivotTables( _
    "PivotTable").PivotFields("PROGRAM_TYPE_LETTER"), "Sum of amount", xlSum
End With

End Sub