同步切片机

我有两个源表和几十个基于它们的枢轴。

两个表格有一个共同的字段，它们具有一组可能的值。

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

我希望能够同步它们。

也就是说，如果用户selectSlicer_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

现在如何在切片机1改变时自动触发它？ 我已经将该macros分配给了slicer_2，但更新不会发生，直到单击切片器框。

而且，如何在执行所有更改之前延迟执行。 此时它更新A字段（select是/否）刷新我的表并移动到B等。

我希望它等待刷新，直到所有的切片机领域已经更新

谢谢

Answer 1

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

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

我的解决scheme由4个步骤组成：
1）创buildclsWrapperCache ，一个围绕Excel SlicerCache对象的包装类
2）创buildclsWrapperCaches ，一个clsWrapperCache对象的集合类
3）创buildclsCacheManager ，一个用于处理SlicerCache对象状态的pipe理器类
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对象。
更重要的是：它可以pipe理一个SlicerCache的状态。 获得状态可以做得非常快，即通过连接：

• 第一个VisibleSlicerItem的名字
• VisibleSlicerItems的数量。

OldState最初设置在Set_Caches例程（步骤3）中，并且如果同步过程中涉及到Set_Caches器caching，则可以在Synchronize_Caches例程（步骤3）中重置Set_Caches 。

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_Cachespipe理caching状态。
Set_Caches ：如果ThisWorkbook中的caching数量与Set_Caches的caching数量不同，则（重新）构buildAllCaches集合。 因此每个分割器caching的OldState被保存。

Synchronize_Caches ：所有caching都在这里遍历。 如果一个分割器caching已经被更新（ oWCfrom.CurrentState <> oWCfrom.OldState ）比任何具有相同的SourceName（例如“年”）的其他caching也将得到更新。 更新是通过从源caching中将所有切片器项select复制到目标caching。 涉及所有caching的OldState在同步过程结束时重置为当前状态。

4）ThisWorkbook，设置对cachingpipe理器的调用

 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到步骤3的所有好处都可以在步骤4中获得：我们可以像调用SetCaches或Synchronize_Caches一样调用CacheManager。 这段代码很容易阅读。

这个解决scheme的优点：

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

Answer 2

我在过去提出了同样的问题，在我看来，同步数据透视表比使用切片器容易。当您连接几个数据透视表 （具有相同的caching）到切片机 ，改变任何这些数据透视表字段（从中创build切片机 ）改变切片机select以及其余的数据透视表 。

例如，你有12个枢轴表和2个切片机，6个分配给1，另外6个分配给另一个。
也让我们说你有一个共同的领域工作周与所有的数据透视表中完全相同的项目，你可以尝试这样的事情：

 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）的工作表中。
注意下面这个例子的假设：

1. 报表filter （不是行/列 ）上的PT1和PT2具有WorkWeek字段。
2. PT1与Slicer1连接，PT2与Slicer2连接。
3. 没有多重select是允许的（至less在以上设置）。

所以基本上发生了什么是当你改变链接到切片机1的PT1工作周期select，
PT2也会改变，这也会改变Slicer2的select。
如果更改切片机1或2的select，则会发生相同的效果。
切片机1中的任何select更改将在切片机2上生效。
这只是想法。 我不知道您是否将字段放在“报表filter”或“ 行/列”上 。
您可以根据需要调整上述样本以防万一。
要select多个项目，您将不得不使用循环来分配和select每个项目。 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 

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

Answer 4

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

 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