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

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

如何清除运行时错误？
如何使我的宏仅运行一次？
如何检查范围中的数据是否已更改？

我解释了您的问题，好像您只是希望错误消失一样。因此，您只需删除旧表并将其替换为新表即可。

赞：

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

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

1 个答案: