Question

我有两个源表，还有几十个基于它们的支点。

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

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

我希望能够同步它们。

即如果用户在Slicer_1中选择值A，则Slicer_2会自动更新以选择值A.

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

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

现在，当slicer_1发生变化时，我将如何自动触发它？我已将宏指定给slicer_2，但在单击切片器框之前不会进行更新。

如何在执行所有更改之前延迟执行。此时它会更新A字段（选择是/否）刷新我的表格并转到B等等。

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

谢谢

Answer 1

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

实现这一切的方法是保存所有切片器缓存对象的状态。在数据透视表（底层的一个或多个切片器缓存）中进行更改后，可以将新状态与旧状态和已识别的更新缓存进行比较。从那里可以实现同步。

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

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

clsWrapperCache包含Excel SlicerCache对象更重要的是：它可以管理SlicerCache的状态。获得状态可以非常快速地完成，即通过连接：

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

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

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

这是一个简单的集合类，只持有clsWrapperCache个对象。它将用于保存AllCaches集合中的对象。

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

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

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

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

步骤1中可以获得步骤1到3的Alle好处：我们可以调用CacheManager，如SetCaches或Synchronize_Caches。此代码易于阅读。

此解决方案的优点：

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

Answer 2

我在过去遇到了同样的问题，在我看来，同步数据透视表比 Slicers 更容易。当你连接几个数据透视表时< / em>（使用相同的缓存）进入 Slicer ，更改任何数据透视表字段（从中创建 Slicer ）更改切片器选择以及其他数据透视表。

例如，你有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

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

PT1和PT2在报告过滤器上有 WorkWeek 字段（不是行/列）。

PT1链接到Slicer1，PT2链接到Slicer2。

不允许多重选择（至少对于上面的设置）。

所以基本上发生的情况是当您更改与Slicer1相关联的PT1 WorkWeek选择时，PT2也会发生变化，这也会改变Slicer2的选择。
如果更改Slicer1或2选择，将发生相同的效果。
Slicer1中的任何选择更改都将对Slicer2生效这只是想法。我不知道您是否在报告过滤器或行/列上放置字段。
您可以调整上述样本以满足您的需求情况。
要选择多个项目，您必须使用循环来分配和选择每个项目。 HTH。

Answer 3

我最终使用了这段代码：



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

它被链接到我的一个数据透视表的更新触发器。

Answer 4

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

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

同步切片机

4 个答案: