vba：创建数据透视表

Question

I have to create a pivot table using vba but i got the following error: "Run-time error '438' Object doesn't support this property or method" about this code: ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Sheet1!R1C1:R1048576C8", Version:=6).CreatePivotTable TableDestination:= _ pivotTableWs!R1C1, tableName:=tableName, DefaultVersion:=6

here the complete source

Dim tableName As String
Dim pivotTableWs As Worksheet

tableName = "pivotTableName"

Set pivotTableWs = Sheets.Add(after:=Worksheets("Sheet1"))
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Sheet1!R1C1:R1048576C8", Version:=6).CreatePivotTable TableDestination:= _
    pivotTableWs!R1C1, tableName:=tableName, DefaultVersion:=6
Sheets(pivotTableWs).Select
Cells(1, 1).Select
With ActiveSheet.PivotTables(tableName)
    .ColumnGrand = True
    .HasAutoFormat = True
    .DisplayErrorString = False
    .DisplayNullString = True
    .EnableDrilldown = True
    .ErrorString = ""
    .MergeLabels = False
    .NullString = ""
    .PageFieldOrder = 2
    .PageFieldWrapCount = 0
    .PreserveFormatting = True
    .RowGrand = True
    .SaveData = True
    .PrintTitles = False
    .RepeatItemsOnEachPrintedPage = True
    .TotalsAnnotation = False
    .CompactRowIndent = 1
    .InGridDropZones = False
    .DisplayFieldCaptions = True
    .DisplayMemberPropertyTooltips = False
    .DisplayContextTooltips = True
    .ShowDrillIndicators = True
    .PrintDrillIndicators = False
    .AllowMultipleFilters = False
    .SortUsingCustomLists = True
    .FieldListSortAscending = False
    .ShowValuesRow = False
    .CalculatedMembersInFilters = False
    .RowAxisLayout xlCompactRow
End With
With ActiveSheet.PivotTables(tableName).PivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables(tableName).RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables(tableName).PivotFields("field1")
    .Orientation = xlRowField
    .Position = 1
End With
ActiveSheet.PivotTables(tableName).AddDataField ActiveSheet.PivotTables( _
    tableName).PivotFields("ticketid"), "Count of field1", xlCount
With ActiveSheet.PivotTables(tableName).PivotFields("field2")
    .Orientation = xlColumnField
    .Position = 1
End With

I create this code using "Developer" tab, selected "Macro register" and i create pivot table manually

Answer 1

I've added 2 Object variables PvtTbl As PivotTable and PvtCache As PivotCache to make the code more dynamic.

Other explanations are inside the code below (as comments).

Code

Option Explicit

Sub AutoPivot()

Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache

Dim PvtTblName As String
Dim pivotTableWs As Worksheet

PvtTblName = "pivotTableName"

' set the worksheet object where we will create the Pivot-Table
Set pivotTableWs = Sheets.Add(after:=Worksheets("Sheet1"))

' set the Pivot Cache (the Range is static)
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Sheet1!R1C1:R1048576C8")

' create a new Pivot Table in the new created sheet
Set PvtTbl = pivotTableWs.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=pivotTableWs.Range("A1"), TableName:=PvtTblName)

' after we set the PvtTbl object, we can easily modifty all it's properties
With PvtTbl
    .ColumnGrand = True
    .HasAutoFormat = True
    .DisplayErrorString = False
    .DisplayNullString = True
    .EnableDrilldown = True
    .ErrorString = ""
    .MergeLabels = False
    .NullString = ""
    .PageFieldOrder = 2
    .PageFieldWrapCount = 0
    .PreserveFormatting = True
    .RowGrand = True
    .SaveData = True
    .PrintTitles = False
    .RepeatItemsOnEachPrintedPage = True
    .TotalsAnnotation = False
    .CompactRowIndent = 1
    .InGridDropZones = False
    .DisplayFieldCaptions = True
    .DisplayMemberPropertyTooltips = False
    .DisplayContextTooltips = True
    .ShowDrillIndicators = True
    .PrintDrillIndicators = False
    .AllowMultipleFilters = False
    .SortUsingCustomLists = True
    .FieldListSortAscending = False
    .ShowValuesRow = False
    .CalculatedMembersInFilters = False
    .RowAxisLayout xlCompactRow

    With .PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With

    .RepeatAllLabels xlRepeatLabels

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

    .AddDataField .PivotFields("ticketid"), "Count of field1", xlCount

    With .PivotFields("field2")
        .Orientation = xlColumnField
        .Position = 1
    End With

End With

End Sub

Answer 2

I had the same need for a loop. This is what I used (with comments). It should work with any dataset.

Sub createPivot()
'declare Range variable
Dim dataRange As Range  


'get last row and last column in the data sheet
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column

'set value for  dataRange; this is dynamic and will work for any dataset
Set dataRange = Range(Cells(1, 1), Cells(lastrow, lastcol))
dataRange.Select

'create new WS and insert blank pivot table
Sheets.Add
ActiveSheet.Name = "Pivot"
ActiveWorkbook.PivotCaches.Create(xlDatabase, dataRange, 6).CreatePivotTable Sheets("Pivot").Range("A3"), "PivotTable1", dataRange, 6


' the following 2 blocks are optional
'Insert Row Fields
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Rights Holder")
.Orientation = xlRowField
.Position = 1
End With

'Insert Values fields
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Number of tracks")
.Orientation = xlDataField
.Function = xlSum
End With

End Sub