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