使用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