使用VBA更改所有数据透视表上的过滤器

Question

我有一个带有几百个数据透视表的Excel工作簿。所有数据透视表都使用来自SSAS多维数据集的数据。这些表格的结构基本相同，但它们具有不同的“位置”过滤器。我想要做的是有代码将更改所有表的“日期”过滤器，以便我不需要手动更新每个表。 （不，切片机不适合我）。我对使用VBA非常陌生，所以我有点茫然。我发现了这个代码，我认为这可能会起作用，但是它对我来说确实清除了其他表格上的过滤器......可能是因为我从外部来源提取？任何帮助将不胜感激。

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) 
On Error Resume Next 
Dim wsMain As Worksheet 
Dim ws As Worksheet 
Dim ptMain As PivotTable 
Dim pt As PivotTable 
Dim pfMain As PivotField 
Dim pf As PivotField 
Dim pi As PivotItem 
Dim bMI As Boolean 

On Error Resume Next 
Set wsMain = ActiveSheet 
Set ptMain = Target 

Application.EnableEvents = False 
Application.ScreenUpdating = False 

For Each pfMain In ptMain.PageFields 
bMI = pfMain.EnableMultiplePageItems 
For Each ws In ThisWorkbook.Worksheets 
    For Each pt In ws.PivotTables 
     If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then 
      pt.ManualUpdate = True 
      Set pf = pt.PivotFields(pfMain.Name) 
        bMI = pfMain.EnableMultiplePageItems 
        With pf 
         .ClearAllFilters 
         Select Case bMI 
          Case False 
           .CurrentPage = pfMain.CurrentPage.Value 
          Case True 
           .CurrentPage = "(All)" 
           For Each pi In pfMain.PivotItems 
            .PivotItems(pi.Name).Visible = pi.Visible 
           Next pi 
           .EnableMultiplePageItems = bMI 
         End Select 
        End With 
        bMI = False 

      Set pf = Nothing 
      pt.ManualUpdate = False 
     End If 
    Next pt 
Next ws 
Next pfMain 

Application.EnableEvents = True 
Application.ScreenUpdating = True 

End Sub 

Answer 1

请尝试下面的代码。

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) 
On Error Resume Next 
Dim wsMain As Worksheet 
Dim ws As Worksheet 
Dim ptMain As PivotTable 
Dim pt As PivotTable 
Dim pfMain As PivotField`enter code here` 
Dim pf As PivotField 
Dim pi As PivotItem 

Dim pvfilter as string 
On Error Resume Next 
Set wsMain = ActiveSheet 
Set ptMain = Target 

Application.EnableEvents = False 
Application.ScreenUpdating = False 
pvfilter = InputBox("Enter the pivot filter string") 
For Each pfMain In ptMain.PageFields 

For Each ws In ThisWorkbook.Worksheets 
    For Each pt In ws.PivotTables 
     If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then 
      pt.ManualUpdate = True 
      Set pf = pt.PivotFields(pfMain.Name) 

        With pf 
         .ClearAllFilters 
           .CurrentPage = pvfilter 
        End With 


      Set pf = Nothing 
      pt.ManualUpdate = False 
     End If 
    Next pt 
Next ws 
Next pfMain 

Application.EnableEvents = True 
Application.ScreenUpdating = True 

End Sub 

Answer 2

我会建议您更新此代码作为子程序，每当你需要应用过滤器来透视表，而不是直接使用枢轴更新事件的代码运行此宏。

Sub Test() 
On Error Resume Next 
Dim wsMain As Worksheet 
Dim ws As Worksheet 
Dim ptMain As PivotTable 
Dim pt As PivotTable 
Dim pfMain As PivotField 
Dim pf As PivotField 
Dim pi As PivotItem 

Dim pvfilter As String 
On Error Resume Next 
Set wsMain = ActiveSheet 
Set ptMain = Target 

Application.EnableEvents = False 
Application.ScreenUpdating = False 
pvfilter = InputBox("Enter the pivot filter string") 
For Each pfMain In ptMain.PageFields 

For Each ws In ThisWorkbook.Worksheets 
    For Each pt In ws.PivotTables 
     If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then 
      pt.ManualUpdate = True 
      Set pf = pt.PivotFields(pfMain.Name) 

        With pf 
         .ClearAllFilters 
           .CurrentPage = pvfilter 
        End With 


      Set pf = Nothing 
      pt.ManualUpdate = False 
     End If 
    Next pt 
Next ws 
Next pfMain 

Application.EnableEvents = True 
Application.ScreenUpdating = True 

End Sub