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

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

2 个答案: