使用VBA更改所有数据透视表上的filter

我有一个有数百个数据透视表的Excel工作簿。 所有数据透视表都使用来自SSAS多维数据集的数据。 这些表格基本上都是以相同的方式构build的，但它们具有不同的“位置”filter。 我想要做的是具有将更改所有表的“date”filter的代码，以便我不需要手动更新每个表。 （不，切片机不会为我工作）。 我对使用VBA非常陌生，所以我有些茫然。 我发现这个代码，我认为可能工作，但它所做的是清除其他表上的filter…可能是因为我从外部来源拉？ 任何帮助将不胜感激。

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

我build议你更新这个代码作为子程序，并运行这个macros，每当你需要应用一个filter的数据透视表，而不是直接使用数据透视表更新事件中的代码。

 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