vba 同步切片器

Synchronizing slicers

提问by Ben

I have two source tables, and several dozen pivots based on them.

我有两个源表，以及基于它们的几十个数据透视表。

There is a common field to the two tables with common set of possible values.

这两个表有一个共同的字段，有一组共同的可能值。

I have two slicers (one per source table). Each slicer controlling a number of associated Pivot Tables.

我有两个切片器（每个源表一个）。每个切片器控制多个关联的数据透视表。

I would like to be able to synchronize them.

我希望能够同步它们。

That is if user selects value A in Slicer_1, Slicer_2 gets automatically updated to have value A selected as well.

也就是说，如果用户在 Slicer_1 中选择值 A，则 Slicer_2 会自动更新以选择值 A。

So what I have so far is very basic

所以到目前为止我所拥有的是非常基本的

ActiveWorkbook.SlicerCaches("Slicer_1").SlicerItems("A").Selected = ActiveWorkbook.SlicerCaches("Slicer_2").SlicerItems("A").Selected ActiveWorkbook.SlicerCaches("Slicer_1").SlicerItems("B").Selected = ActiveWorkbook.SlicerCaches("Slicer_2").SlicerItems("B").Selected ActiveWorkbook.SlicerCaches("Slicer_1").SlicerItems("C").Selected = ActiveWorkbook.SlicerCaches("Slicer_2").SlicerItems("C").Selected

ActiveWorkbook.SlicerCaches("Slicer_1").SlicerItems("A").Selected = ActiveWorkbook.SlicerCaches("Slicer_2").SlicerItems("A").Selected ActiveWorkbook.SlicerCaches("Slicer_1").SlicerItems("B").Selected = ActiveWorkbook.SlicerCaches("Slicer_2").SlicerItems("B").Selected ActiveWorkbook.SlicerCaches("Slicer_1").SlicerItems("C").Selected = ActiveWorkbook.SlicerCaches("Slicer_2").SlicerItems("C").Selected

Now how would I got about triggering it automatically when slicer_1 changes ? I have assigned the macro to slicer_2, but the update does not happen until the the slicer box is clicked.

现在，当 slicer_1 更改时，我将如何自动触发它？我已将宏分配给 slicer_2，但在单击切片器框之前不会发生更新。

And how do I delay execution until all the changes have been applied. At this time it updates the A field (selected yes/no) refreshes my tables and moves on to B and etc.

以及如何延迟执行，直到应用了所有更改。此时它更新 A 字段（选择是/否）刷新我的表并移动到 B 等。

I want it to wait with the refresh until all the slicer fields have been updated

我希望它等待刷新，直到所有切片器字段都已更新

Thank you

谢谢

采纳答案by Rene

Synchronizing slicers can be done in a generic way.
With "generic" I mean that there should be no dependency on (literal) slicer cache names and synchronizing could start from any slicer cache.

同步切片器可以以通用方式完成。
对于“通用”，我的意思是不应该依赖（文字）切片器缓存名称，并且同步可以从任何切片器缓存开始。

The approach to bring this all about is by saving state of all slicer cache objects. After a change in a pivot table (underlying one or more slicer caches) new states can be compared with old states and updated caches recognized. From there synchronizing can be accomplished.

实现这一切的方法是保存所有切片器缓存对象的状态。在数据透视表（在一个或多个切片器缓存的基础上）发生变化后，可以将新状态与旧状态进行比较并识别更新的缓存。从那里可以完成同步。

My solution consists of 4 steps:
1) create clsWrapperCache, a wrapper class around Excel SlicerCache object
2) create clsWrapperCaches, a collection class of clsWrapperCache objects
3) create clsCacheManager, a manager class for dealing with SlicerCache object states
4) ThisWorkbook, setting calls to the manager

我的解决方案包括 4 个步骤：
1) create clsWrapperCache，一个围绕 Excel SlicerCache 对象的包装类
2) create clsWrapperCaches，一个 clsWrapperCache 对象的集合类
3) create clsCacheManager，一个用于处理 SlicerCache 对象状态的管理器类
4) ThisWorkbook，设置对管理器的调用

1) clsWrapperCache, wrapper class around Excel SlicerCache object

1) clsWrapperCache，Excel SlicerCache 对象的包装类

' wrapper class around Excel SlicerCache object
Option Explicit
Public Object As SlicerCache
Public OldState As String

Public Function CurrentState() As String
    ' state is set by:
    ' a) name of first visible slicer item
    ' b) number of visible slicer items
    Dim s As String

    If Object.VisibleSlicerItems.Count > 0 Then
        s = Object.VisibleSlicerItems.Item(1).Name
    Else
        s = ""
    End If
    s = s & vbCrLf ' separator that cannot be found in a SlicerItem name
    s = s & CStr(Object.VisibleSlicerItems.Count)

    CurrentState = s
End Function

clsWrapperCacheholds an Excel SlicerCache object.
More importantly: it can administer state of a SlicerCache. Obtaining state can be done very fast, i.e. by concatenating:

clsWrapperCache持有一个 Excel SlicerCache 对象。
更重要的是：它可以管理 SlicerCache 的状态。获取状态可以非常快地完成，即通过连接：

• the name of the 1st VisibleSlicerItem and
• the number of VisibleSlicerItems.

• 第一个 VisibleSlicerItem 的名称和
• VisibleSlicerItems 的数量。

OldStateis initially set in the Set_Cachesroutine (step 3) and can be reset in de Synchronize_Cachesroutine (step 3) if the slicer cache was involved in the synchronizing process.

OldState最初在Set_Caches例程中设置Synchronize_Caches（步骤 3），如果切片器缓存参与同步过程，则可以在例程中重置（步骤 3）。

2) clsWrapperCaches, collection class of clsWrapperCache objects

2）clsWrapperCaches，clsWrapperCache对象的集合类

' clsWrapperCaches, collection class of clsWrapperCache objects
Option Explicit

Private mcol As New Collection

Public Sub Add(oWC As clsWrapperCache)
    mcol.Add oWC, oWC.Object.Name
End Sub

Public Property Get Item(vIndex As Variant) As clsWrapperCache
    ' vIndex may be of type integer or string
    Set Item = mcol(vIndex)
End Property

Public Property Get Count() As Integer
    Count = mcol.Count
End Property

This is a simple collection class, merely holding clsWrapperCacheobjects. It will be used for holding objects in the AllCachescollection.

这是一个简单的集合类，仅clsWrapperCache包含对象。它将用于保存集合中的对象AllCaches。

3) clsCacheManager, class for dealing with SlicerCache object states

3）clsCacheManager，处理SlicerCache对象状态的类

Option Explicit

Public AllCaches As New clsWrapperCaches

Public Sub Set_Caches()
    Dim sc As SlicerCache
    Dim oWC As clsWrapperCache
    Dim i As Integer

    If Me.AllCaches.Count <> ThisWorkbook.SlicerCaches.Count Then
        ' a) on Workbook_Open event
        ' b) maybe the user has added/deleted a Slice Cache shape by hand
        Set AllCaches = New clsWrapperCaches
        For Each sc In ThisWorkbook.SlicerCaches
            'create a wrapper SlicerCache object
            Set oWC = New clsWrapperCache
            Set oWC.Object = sc
            'save current state of SlicerCache into OldState
            oWC.OldState = oWC.CurrentState

            ' add wrapper object to collection
            AllCaches.Add oWC
        Next
    End If
End Sub

Sub Synchronize_Caches()
    ' copy current selections from slicer caches "FromCaches" into any other slicer cache with same SourceName
    On Error GoTo ErrEx
    Dim oWCfrom As clsWrapperCache
    Dim oWCto As clsWrapperCache
    Dim scFrom As SlicerCache
    Dim scTo As SlicerCache
    Dim si As SlicerItem

    Dim i As Integer
    Dim j As Integer

    Application.EnableEvents = False ' prevent executing Workbook_SheetPivotTableUpdate event procedure
    Application.ScreenUpdating = False

    For i = 1 To Me.AllCaches.Count
        Set oWCfrom = Me.AllCaches.Item(i)
        If oWCfrom.CurrentState <> oWCfrom.OldState Then
            Set scFrom = oWCfrom.Object
            For j = 1 To Me.AllCaches.Count
                Set oWCto = Me.AllCaches.Item(j)
                Set scTo = oWCto.Object

                ' Debug.Print oWCto.Name
                If scTo.Name <> scFrom.Name And scTo.SourceName = scFrom.SourceName Then
                    scTo.ClearAllFilters ' triggers a Workbook_SheetPivotTableUpdate event
                    On Error Resume Next
                        For Each si In scFrom.SlicerItems
                            scTo.SlicerItems(si.Name).Selected = si.Selected
                        Next
                    On Error GoTo 0

                    ' update old state of wrapper object oWCto
                    oWCto.OldState = oWCto.CurrentState
                End If
            Next
            ' update old state of wrapper object oWCfrom
            oWCfrom.OldState = oWCfrom.CurrentState
        End If
    Next

Ex:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
ErrEx:
    MsgBox Err.Description
    Resume Ex
End Sub

Class clsCacheManager manages cache states with methods Set_Cachesand Synchronize_Caches.
Set_Caches: if the number of caches in ThisWorkbook differs from that of AllCaches, AllCaches collection is (re)built. Hereby the OldStateof every slicer cache is saved.

类 clsCacheManager 使用方法Set_Caches和管理缓存状态Synchronize_Caches。
Set_Caches: 如果 ThisWorkbook 中的缓存数量与 AllCaches 的数量不同，则（重新）构建 AllCaches 集合。从而OldState保存每个切片器缓存的 。

Synchronize_Caches: all caches are traversed here. If a slicer cache has been updated (oWCfrom.CurrentState <> oWCfrom.OldState) than any other cache with the same SourceName (e.g. 'year') will also get updated. Updating is by copying all selections of slicer items from source cache to destination cache. OldStatefor all caches involved is reset to current state at the end of the synchronizing process.

Synchronize_Caches: 所有缓存都在这里遍历。如果切片器缓存已更新 ( oWCfrom.CurrentState <> oWCfrom.OldState)，则具有相同 SourceName（例如“年份”）的任何其他缓存也将更新。更新是通过将切片器项目的所有选择从源缓存复制到目标缓存。OldState在同步过程结束时，所有涉及的缓存都被重置为当前状态。

4) ThisWorkbook, setting calls to the cache manager

4）ThisWorkbook，设置对缓存管理器的调用

Option Explicit
Private mCacheManager As New clsCacheManager

Private Sub Workbook_Open()
    SetCacheManager
    mCacheManager.Set_Caches
End Sub

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
    SetCacheManager
    mCacheManager.Set_Caches
    mCacheManager.Synchronize_Caches
End Sub

Private Sub SetCacheManager()
    If mCacheManager Is Nothing Then
        Set mCacheManager = New clsCacheManager
    End If
End Sub

Alle benefits from steps 1 to 3 can be reaped in step 4: we can do calls to CacheManager like SetCachesor Synchronize_Caches. This code is easy to read.

步骤 1 到 3 的好处可以在步骤 4 中获得：我们可以像SetCaches或一样调用 CacheManager Synchronize_Caches。这段代码很容易阅读。

Advantages of this solution:

该解决方案的优点：

1. works for all slicer caches in a workbook
2. does not depend on SlicerCache names
3. very fast, because states of slicer cache objects are obtained very fast
4. extendable. Class clsCacheManagercould be extended for dealing with dependencies between slicer caches.

1. 适用于工作簿中的所有切片器缓存
2. 不依赖于 SlicerCache 名称
3. 非常快，因为获取切片器缓存对象的状态非常快
4. 可扩展。clsCacheManager可以扩展类以处理切片器缓存之间的依赖关系。

回答by L42

I came up with the same problem in the past and in my opinion, synchronizing Pivot Tableis easier than Slicers.When you connect several Pivot Tables(with same cache) into a Slicer, altering any of those Pivot Tablesfield (from which you created the Slicer) changes the Slicer Selectionas well as the rest of the Pivot Tables.

我想出了过去，在我看来同样的问题，同步数据透视表是很容易，切片器。当你连接多个数据透视表（用同一个缓存）到切片机，改变其中任何的数据透视表字段（从您创建在切片机）改变了切片机的选择以及对其余数据透视表。

So for example you have 12 Pivot Tables and 2 Slicers, 6 assigned to 1 and another 6 assigned to the other.
Also let us say you have a common field WorkWeekwith the exact same items present in all Pivot Tables, you can try something like this:

例如，您有 12 个数据透视表和 2 个切片器，其中 6 个分配给 1，另外 6 个分配给另一个。
还假设您有一个公共字段WorkWeek，其中所有数据透视表中都存在完全相同的项目，您可以尝试以下操作：

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    On Error GoTo halt
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim ww As String, pF1 As PivotField, pF2 As PivotField
    Set pF1 = Me.PivotTables("PT1").PivotFields("WorkWeek")
    Set pF2 = Me.PivotTables("PT2").PivotFields("WorkWeek")
    Select Case True
    Case Target.Name = "PT1"
        ww = pF1.CurrentPage
        If pF2.CurrentPage <> ww Then pF2.CurrentPage = ww
    Case Target.Name = "PT2"
        ww = pF2.CurrentPage
        If pF1.CurrentPage <> ww Then pF1.CurrentPage = ww
    End Select
forward:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
halt:
    MsgBox Err.Number & ": " & Err.Description
    Resume forward
End Sub

You put this code in the sheet that contains your Target Pivot Tables(PT1 and PT2 in above example).
Take note of the following assumptions for this example:

您将此代码放在包含目标数据透视表（上例中的 PT1 和 PT2）的工作表中。
请注意此示例的以下假设：

1. PT1 and PT2 have WorkWeekfield on Report Filter(not Rows/Columns).
2. PT1 is linked to Slicer1 and PT2 is linked on Slicer2.
3. No multiple selection is allowed (at least for above set up).

1. PT1 和 PT2在报告过滤器（不是Rows/Columns）上有WorkWeek字段。
2. PT1 链接到 Slicer1，PT2 链接到 Slicer2。
3. 不允许多选（至少对于上述设置）。

So basically what happens is when you change PT1 WorkWeek selection which is linked to Slicer1,
PT2 changes as well which in turn changes Slicer2 selection as well.
If you change the Slicer1 or 2 selection, the same effect will take place.
Any selection change in Slicer1 will take effect on Slicer2.
This is just the idea. I don't know if you are putting fields on Report Filteror Rows/Columns.
You can adjust the said sample to suit your needs just in case.
To select multiple items, you will have to use a loop to assign and select each of the items. HTH.

所以基本上发生的事情是当您更改链接到 Slicer1 的 PT1 WorkWeek 选择时，
PT2 也会更改，这反过来也会更改 Slicer2 选择。
如果您更改 Slicer1 或 2 选择，将发生相同的效果。
Slicer1 中的任何选择更改都将对 Slicer2 生效。
这只是想法。我不知道您是将字段放在Report Filter还是Rows/Columns 上。
以防万一，您可以调整所述样本以满足您的需要。
要选择多个项目，您必须使用循环来分配和选择每个项目。哈。

回答by Ben

I ended up using this code:

我最终使用了这段代码：

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim sc1 As SlicerCache
    Dim sc2 As SlicerCache
    Dim si1 As SlicerItem

    Set sc1 = ThisWorkbook.SlicerCaches("Slicer_Cache1")
    Set sc2 = ThisWorkbook.SlicerCaches("Slicer_Cache2")

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    sc2.ClearManualFilter

    For Each si1 In sc1.SlicerItems
            sc2.SlicerItems(si1.Name).Selected = si1.Selected
    Next si1


    MsgBox "Update Complete"

    clean_up:
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Exit Sub

    err_handle:
        MsgBox Err.Description
        Resume clean_up
    End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim sc1 As SlicerCache
    Dim sc2 As SlicerCache
    Dim si1 As SlicerItem

    Set sc1 = ThisWorkbook.SlicerCaches("Slicer_Cache1")
    Set sc2 = ThisWorkbook.SlicerCaches("Slicer_Cache2")

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    sc2.ClearManualFilter

    For Each si1 In sc1.SlicerItems
            sc2.SlicerItems(si1.Name).Selected = si1.Selected
    Next si1


    MsgBox "Update Complete"

    clean_up:
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Exit Sub

    err_handle:
        MsgBox Err.Description
        Resume clean_up
    End Sub

It's linked to as an update trigger to one of my pivot tables.

它作为更新触发器链接到我的数据透视表之一。

回答by Phil O'Brien-moran

I used the code below. It also adds the names selected on the slicer to a field names 'Header' which I reference in the pivot table titles.

我使用了下面的代码。它还会将切片器上选择的名称添加到我在数据透视表标题中引用的字段名称“标题”中。

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim pi As PivotItem
Dim dest As PivotField

    If Target.Name = "PivotMPM" Then
       Application.EnableEvents = False
       Application.ScreenUpdating = False
       Application.Calculation = xlCalculationManual
       Set dest = PivotTables("PivotHW").PivotFields("IT Region")
       On Error GoTo What_Happened
       Range("Header") = ""
    ' You cannot select NOTHING, so first go and turn on the ones we want, then go and turn off the others!
      For Each pi In Target.PivotFields("IT Region").PivotItems   ' Now we set them the same as the other one!
         If pi.Visible And dest.PivotItems(pi.Name).Visible = False Then
            dest.PivotItems(pi.Name).Visible = pi.Visible
         End If
         If pi.Visible Then
            Range("Header") = Range("Header") & pi.Name & ", "
         End If
      Next pi
      Range("Header") = Left(Range("Header"), Len(Range("Header")) - 2)
      For Each pi In Target.PivotFields("IT Region").PivotItems   ' Now we set them the same as the other one!
         If pi.Visible <> dest.PivotItems(pi.Name).Visible Then
            dest.PivotItems(pi.Name).Visible = pi.Visible
         End If
      Next pi
    End If
    Done:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub

What_Happened:
MsgBox Err.Description
GoTo Done
End Sub