簡體   English   中英

錄制宏以創建透視網格時出錯

[英]Error recording macro to create Pivot Grid

我看到此錯誤:運行時錯誤 '1004' 應用程序定義或對象定義錯誤Error

我看過幾個帖子,但無法弄清楚。

創建 ActiveWorkbook.PivotCaches.Create() 時,此行出現錯誤。 好像它在 SourceData 部分。

Sub Macro10()
'
' Macro10 Macro
'

'
    Columns("A:I").Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "FoodSales!R1C1:R1048576C9", Version:=7).CreatePivotTable TableDestination _
        :="Sheet16!R3C1", TableName:="PivotTable8", DefaultVersion:=7
    Sheets("Sheet16").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable8")
        .ColumnGrand = True

我正在嘗試制作以下數據透視表:

行 - 城市列 - 產品數據 - 總價

我究竟做錯了什么?

這是完整的代碼:

Sub Macro10()
'
' Macro10 Macro
'

'
    Columns("A:I").Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "FoodSales!R1C1:R1048576C9", Version:=7).CreatePivotTable TableDestination _
        :="Sheet16!R3C1", TableName:="PivotTable8", DefaultVersion:=7
    Sheets("Sheet16").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable8")
        .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("PivotTable8").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable8").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable8").PivotFields("City")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable8").PivotFields("Product")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
        "PivotTable8").PivotFields("TotalPrice"), "Sum of TotalPrice", xlSum
End Sub

我想我修好了:

我沒有從記錄宏中獲取結果,而是找到了這篇文章,並且能夠更新創建PivotCaches.Create()的頂部以使其更具動態性。

我可以將此代碼添加到頂部,然后錄制的宏的其余部分就完美了!

更新問題區號:

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTableMain").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTableMain"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTableMain")
Set DSheet = Worksheets("FoodSales")
    
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:="PivotTableBraves")

這是完整的結果:

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+B
'
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTableMain").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTableMain"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTableMain")
Set DSheet = Worksheets("FoodSales")
    
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:="PivotTableBraves")

    With ActiveSheet.PivotTables("PivotTableBraves")
        .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("PivotTableBraves").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTableBraves").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTableBraves").PivotFields("Category")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTableBraves").PivotFields("City")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTableBraves").AddDataField ActiveSheet.PivotTables( _
        "PivotTableBraves").PivotFields("TotalPrice"), "Sum of TotalPrice", xlSum
    Range("H19").Select
    ActiveWorkbook.Save
    Range("B5:G10").Select
    Selection.Style = "Currency"
    Range("E8").Select
    ActiveWorkbook.Save
End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM