用于自动刷新数据透视表的宏

Question

我有一个很大的Excel文件，里面有很多数据透视表(来自olap-cube)--每20页中大约有5个。每周我都需要更改数据过滤器，并将它们向前移动一周。我已经写了一个宏，它只为一个透视表做这件事。

Sub Weeks_upd()
'
' Weeks_upd Ìàêðîñ
'
' Ctrl+u
'
    ActiveSheet.PivotTables("PivotTable4").PivotFields( _
        "[Fact data].[Year - Week - day].[Week]").VisibleItemsList = Array("")
    ActiveSheet.PivotTables("PivotTable4").PivotFields( _
        "[Fact data].[Year - Week - day].[Week]").VisibleItemsList = Array( _
        "[Fact data].[Year - Week - day].[Week]").&[202025]", _
        "[Fact data].[Year - Week - day].[Week]").&[202026]", _
        "[Fact data].[Year - Week - day].[Week]").&[202027]", _
        "[Fact data].[Year - Week - day].[Week]").&[202028]")
    ActiveSheet.PivotTables("PivotTable4").PivotFields( _
        "[Fact data].[Year - Week - day].[Week]").VisibleItemsList = Array("")
End Sub

如何为文件中的所有透视表展开此宏？或者，是否有其他方法可以更新数据透视表，而无需实际单击每个表？

Answer 1

这是一个未经测试的提议，但您似乎有以下一行代码：

ActiveSheet.PivotTables("PivotTable4").PivotFields(...

您希望将此应用于工作簿中的所有透视表。好吧，我建议你遍历所有工作表和其中的所有透视表，这两个都可以使用For Each循环来完成，如下所示：

For Each l_sheet in ActiveWorkbook.Worksheets
  For Each l_pivot_table in l_sheet.PivotTables
    l_pivot_table.PivotFields(...
    ...
  Next
Next

Answer 2

看起来你可以创建一个接收参数并应用所有透视表的过程。

Sub test()
    Dim Pv As PivotTable
    Dim Ws As Worksheet
    
    Set Ws = ActiveSheet
    
    For Each Pv In Ws.PivotTables
        setPivot Pv
    Next Pv
        
End Sub

Sub setPivot(Pv As PivotTable)
   Pv.PivotFields( _
        "[Fact data].[Year - Week - day].[Week]").VisibleItemsList = Array("")
    ActiveSheet.PivotTables("PivotTable4").PivotFields( _
        "[Fact data].[Year - Week - day].[Week]").VisibleItemsList = Array( _
        "[Fact data].[Year - Week - day].[Week]").&[202025]", _
        "[Fact data].[Year - Week - day].[Week]").&[202026]", _
        "[Fact data].[Year - Week - day].[Week]").&[202027]", _
        "[Fact data].[Year - Week - day].[Week]").&[202028]")
    Pv.PivotFields( _
        "[Fact data].[Year - Week - day].[Week]").VisibleItemsList = Array("")
End Sub