VBA：创建透视表

Question

我必须使用VBA来创建数据透视表，但我得到了以下错误：“运行时错误‘438’对象不支持此属性或方法”这个代码：ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Sheet1!R1C1:R1048576C8", Version:=6).CreatePivotTable TableDestination:= _ pivotTableWs!R1C1, tableName:=tableName, DefaultVersion:=6

这里完整的源

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 

我用“开发”选项卡，选择“宏寄存器”创建此代码，我创建的数据透视表手动

Answer 1

我加2个对象变量PvtTbl As PivotTable和PvtCache As PivotCache使代码更加动态。

其他解释在下面的代码中（作为注释）。

代码

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