如何重新运行记录的数据透视表宏？

Question

我录制了一个宏来从一个数据源获取数据透视表，并将代码分配给一个按钮。

代码在我第一次执行宏时有效

当我第二次重新运行宏时，它给出了一些运行时错误。我知道表目标范围中已经存在表的原因。如何使我的宏使按钮仅工作一次或仅在源数据表中的数据发生更改时工作？

示例代码

Sub pivotexample()

    Dim pt As PivotTable
    Sheets("pivot_view").Select
    For Each Pt In Sheets("pivot_view").PivotTables
        Sheets("pivot_view").Range(PT.TableRange2.Address).Delete Shift:=xlUp
    Next PT

    Sheets("result").Select
    Cells.Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "result!R1C1:R1048576C26", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="pivot_view!R8C1", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion14
    Sheets("pivot_view").Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("week_name")
        .Orientation = xlPageField
        .Position = 1

        'code for all the pivot table fields.

    End With

    Set pt = Worksheets("pivot_view").PivotTables("PivotTable1")

    Range("A8").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range("A8:I8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveSheet.UsedRange.Copy
    Range("A9").Offset(pt.TableRange1.Rows.Count, 0).Select
    ActiveSheet.Paste
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("task_queue_name")  'getting error in this line, when i run the code for once, it is working fine, the name of the pivotTable2 would be pivotTable2 only, but when i remove the old pivot tables using the loop you have suggested and run that for the second time, the name of the second pivot table is getting changed.
        .Orientation = xlRowField
        .Position = 2
    End With
end sub

Answer 1

请详细说明您的问题，因为您的问题实际上由多个问题组成，例如：

• 如何消除运行时错误？
• 如何让我的宏只运行一次？
• 如何检查 Range 中的数据是否发生了变化？

我将您的问题解释为您只是希望错误消失。 因此，您可以简单地删除旧表并用新表替换它。

像这样：

Sub test()

Sheets("result").Select    'result is source data sheet
Cells.Select
Sheets("pivot_view").Select  'pivot_view is my destination sheet where my pivot table should be placed

'============
'delete previous pivot table, to allow a new pivot table to get created in the same place
'code snippet source https://www.mrexcel.com/forum/excel-questions/518955-vba-delete-pivot-table.html
'code snippet autor Zack Barresse
For Each PT In Sheets("pivot_view").PivotTables
    If PT.name = "PivotTable1" then Sheets("pivot_view").Range(PT.TableRange2.Address).Delete Shift:=xlUp
Next PT
'============

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "result!R1C1:R1048576C26", Version:=xlPivotTableVersion14).CreatePivotTable _
    TableDestination:="pivot_view!R8C1", TableName:="PivotTable1", DefaultVersion _
    :=xlPivotTableVersion14
Sheets("pivot_view").Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("week_name")
    .Orientation = xlPageField
    .Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("team_manager")
    .Orientation = xlPageField
    .Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
    "vertical_or_sub_initiative")
    .Orientation = xlRowField
End With
End Sub

当前代码将删除工作表“pivot_view”上的所有数据透视表。如果您只想创建和删除特定的，试试这个：

Sub recreate_pivot()
    Call delete_pvt("pivot_view", "PivotTable1")
    Call test("result", "pivot_view", "PivotTable1", "A1:C3", "A8")

    Call delete_pvt("pivot_view", "PivotTable2")
    Call test("result", "pivot_view", "PivotTable2", "A1:C3", "D8")

End Sub


Sub delete_pvt(pvt_sheet As String, pvt_name As String)

'============
'delete previous pivot table, to allow a new pivot table to get created in the same place
'code snippet source https://www.mrexcel.com/forum/excel-questions/518955-vba-delete-pivot-table.html
'code snippet autor Zack Barresse
'============

For Each PT In Sheets(pvt_sheet).PivotTables
    If PT.Name = pvt_name Then Sheets(pvt_sheet).Range(PT.TableRange2.Address).Delete Shift:=xlUp
Next PT

End Sub

Sub test(source_sheet As String, pvt_sheet As String, pvt_name As String, source_rng As String, dest_rng_str As String)

Dim dest_rng As Range
Set dest_rng = Sheets(pvt_sheet).Range(dest_rng_str)

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    source_sheet & "!" & source_rng).CreatePivotTable _
    TableDestination:=dest_rng, TableName:=pvt_name
Sheets(pvt_sheet).Select

With ActiveSheet.PivotTables(pvt_name).PivotFields("week_name")
    .Orientation = xlPageField
    .Position = 1
End With

With ActiveSheet.PivotTables(pvt_name).PivotFields("team_manager")
    .Orientation = xlPageField
    .Position = 1
End With

With ActiveSheet.PivotTables(pvt_name).PivotFields( _
    "vertical_or_sub_initiative")
    .Orientation = xlRowField
End With

End Sub