vba 如何使多个数据透视表在 excel 中仅在该工作表上模拟另一个过滤器（报告和行标签）？

How can I make multiple pivot tables mimic the filters (report and row label) of another on just that sheet in excel?

提问by dootcher

So I have multiple pivot tables on a single sheet in excel. I have a long list of months in the row labels. The report filter is filterable by names. All of the columns in the pivots are just sums of data.

所以我在excel的一张纸上有多个数据透视表。我在行标签中有很长的月份列表。报告过滤器可按名称过滤。枢轴中的所有列都只是数据的总和。

What I'm looking for (and I'm guessing a macro is the only way to do it), is a way to be able to change the filters of one of the pivots on that sheet and it update the other pivots on only that sheet to mimic the filters (both report and row label) of the one that I changed. Nothing else should change in the other pivot tables - just the filters.

我正在寻找什么（我猜宏是唯一的方法），是一种能够更改该工作表上一个支点的过滤器的方法，并且它仅更新其他支点表来模仿我更改的过滤器（报告和行标签）。其他数据透视表中的任何其他内容都不应更改 - 只是过滤器。

Unfortunately, I literally know nothing about coding vba (I know a bit of java and stuff but I've never done any macro coding). I was able to copy a macro from the internet that did part of what I need; it updates the report filter but doesn't update the dates in the row label filter. Here's the coding for that:

不幸的是，我实际上对编码 vba 一无所知（我知道一些 Java 和其他东西，但我从未做过任何宏编码）。我能够从互联网上复制一个宏来完成我需要的部分工作；它会更新报告过滤器，但不会更新行标签过滤器中的日期。这是编码：

Option Explicit
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

'change all fields for all pivot tables on active sheet

For Each pfMain In ptMain.PageFields
    bMI = pfMain.EnableMultiplePageItems
        For Each pt In wsMain.PivotTables
            If pt <> 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 pfMain

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Is there anyway to do what I'm looking to do? Your help would be GREATLY appreciated!

无论如何要做我想做的事情吗？非常感谢您的帮助！

采纳答案by scott

Without seeing your pivottables it seems that all you need to do to the above code is repeat the steps from setting the pivotfield value to reflect the date. This is done by adding a variant of the loop set up by the line:

如果没有看到您的数据透视表，似乎您需要对上述代码做的就是重复设置数据透视字段值以反映日期的步骤。这是通过添加由该行设置的循环的变体来完成的：

    set pf = pt.pivotfields(pfmain.name)

to

到

    set pf = pt.pivotfields(pfmain.nameofyourrowfiltervariable)

the full code is below, i would also avoid on error resume next

完整代码如下，我也将避免错误恢复下一步

    Option Explicit
    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

    'change all fields for all pivot tables on active sheet

    For Each pfMain In ptMain.PageFields
        bMI = pfMain.enablemultiplepageitems
        For Each pt In wsMain.PivotTables
          If pt <> 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 = pt.pivotfields(pfMain.nameofdatevariable)
               dates = pfMain.enablemultiplepageitems
               with pf
                   .clearallfilters
                   select case dates
                       case false
                               .currentpage = pfmain.currentpage.value
                       case true
                               .currentpage = "(All)"
                               for each pi in pfmain.pivotitems
                                    .pivotitems(pi.nameofdatevariable).visible = pi.visible
                                next pi
                                .enablemultiplepageitems = dates
                       end select
               end with
               date = false
               set pf = nothing
               pt.ManualUpdate = False
           End If
       Next pt
   Next pfMain

  Application.EnableEvents = True
  Application.ScreenUpdating = True

  End Sub

try it and see if it works I have not tested this

试试看它是否有效我还没有测试过