按下切片机时，在Excel中禁用其他切片器

我有三个切片机在Excel中的数据透视表和透视图上操作。 但是，当其中一个切片机被按下时，必须清除从另外两个切片机放置的滤光片，以确保只有一个切片机同时工作。 我认为这必须使用VBA解决，聆听点击，然后执行代码，除此之外，我不知道，因为我从来没有使用Excel或VBA以前。 任何人有什么build议，我会如何做到这一点？

Answer 1

计算Slicer得到点击的确实非常棘手，因为通过单击切片器引发的唯一应用程序事件是PivotTable_Update事件。 此事件告诉我们切片机连接到哪个数据透视表，但没有过滤该数据透视表中的哪个字段 。 所以如果你有多个连接到数据透视表的sillers，你不能分辨出哪一个被点击了。

我想出了一个非常复杂的解决方法，我张贴在http://dailydoseofexcel.com/archives/2014/07/10/what-c​​aused-that-pivottableupdate-episode-iv/ ，这将让你分开的方式：它会告诉你数据透视表中哪个字段刚更新了，然后你只需要遍历所有连接到该数据透视表的切片器，如果它们没有相同的源名，就清除它们。

我会看看能否在适当的时候编码，但是现在我很忙，所以我不能保证快速解决。

请注意，您可以直接将macros分配给切片器，当用户单击该切片器时，可以确定切片器的位置。 但不幸的是，macros会干扰切片机本身：用户不能再实际操作切片机来实际改变任何东西。

—更新—这是一些你想要的代码。 这里有很多不同的模块，因为例程代码调用了我使用的其他一些generics例程。 在这里，核心是一个例程，它可以确定数据透视表的哪个特定字段得到更新，并且不关心是否过滤了多字段字段。

您可以使用此事件处理程序调用它，该处理程序位于Visual Basic编辑器中的本书的ThisWorkbook模块中：

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable) Slicers_OneSlicerOnly Target End Sub 

而这就是依次调用这些其他函数。 您不必修改任何内容，并且可以在您添加到此工作簿的任何数据透视表或切片器上使用。

 Function Slicers_OneSlicerOnly(target As PivotTable) Dim sField As String Dim slr As Slicer Dim sSlicer As String Dim bEnableEvents As Boolean Dim bScreenUpdating As Boolean Dim bManualupdate As Boolean Dim lCalculation As Long Dim bRecordLayout As Boolean Dim sLayout_New As String Dim sLayout_Old As String Dim lng As Long With Application bEnableEvents = .EnableEvents bScreenUpdating = .ScreenUpdating lCalculation = .Calculation .EnableEvents = False .ScreenUpdating = False .Calculation = xlCalculationManual End With bManualupdate = target.ManualUpdate target.ManualUpdate = True sField = Pivots_FieldChange(target) If sField <> "" Then For Each slr In target.Slicers sSlicer = slr.SlicerCache.SourceName If sSlicer <> sField Then If Not target.PivotFields(sSlicer).AllItemsVisible Then target.PivotFields(sSlicer).ClearAllFilters bRecordLayout = True End If End If Next slr End If target.ManualUpdate = bManualupdate If bRecordLayout Then PivotChange_RecordLayout target, sLayout_New With target lng = InStr(.Summary, "[Layout]") sLayout_Old = Mid(.Summary, lng + Len("[Layout]"), InStr(.Summary, "[/Layout]") - Len("[Layout]") - lng) .Summary = Replace(.Summary, "[Layout]" & sLayout_Old & "[/Layout]", "[Layout]" & sLayout_New & "[/Layout]") End With End If With Application .EnableEvents = bEnableEvents .ScreenUpdating = bScreenUpdating .Calculation = lCalculation End With End Function Public Function Pivots_FieldChange(target As PivotTable) As String ' Description: Works out what caused a PivotTableUpdate event, and if caused by someone changing a filter returns the ' name of the PivotField that was filtered. ' Programmer: Jeff Weir ' Contact: [e-mail] or [e-mail] ' Inputs: PivotTable ' Outputs: String ' Name/Version: Date: Ini: Modification: ' PivotChange_20140712 20140712 JSW Initial programming as per http://dailydoseofexcel.com/archives/2014/07/10/what-caused-that-pivottableupdate-episode-iv/ ' PivotChange_20140723 20140423 JSW Restructured code as per http://dailydoseofexcel.com/archives/2014/07/23/broken-arrow/ ' PivotChange_20140802 20140802 JSW Added: If sLastUndoStackItem = "Filter" Or sLastUndoStackItem = "Slicer Operation" Then ' so that Filter routines only get called in response to filtering ' Pivots_FieldChange 20151016 JSW Changed the way info is saved in .summary Dim sLastUndoStackItem As String Dim sField As String Dim sPossibles As String Dim sLayout_New As String Dim sLayout_Old As String On Error Resume Next 'in case the undo stack has been wiped or doesn't exist sLastUndoStackItem = Application.CommandBars(14).FindControl(ID:=128).List(1) 'Standard Commandbar, undo stack On Error GoTo 0 If sLastUndoStackItem = "Filter" Or sLastUndoStackItem = "Slicer Operation" Then sField = PivotChange_CompareLayout(target, sLayout_New, sLayout_Old) If sField = "" Then sField = PivotChange_EliminationCheck(target, sPossibles) If sField = "" Then sField = PivotChange_UndoCheck(target, sPossibles) If sLayout_Old = "" Then target.Summary = "[Layout]" & sLayout_New & "[/Layout]" Else target.Summary = Replace(target.Summary, "[Layout]" & sLayout_Old & "[/Layout]", "[Layout]" & sLayout_New & "[/Layout]") End If End If Pivots_FieldChange = sField Debug.Print Now() & vbTab & "Pivots_FieldChange:" & vbTab & sField End Function Function PivotChange_RecordLayout(pt As PivotTable, ByRef sLayout_New As String) As Boolean Dim pf As PivotField For Each pf In pt.PivotFields With pf Select Case .Orientation Case xlRowField, xlColumnField sLayout_New = sLayout_New & .Name & "|" & .VisibleItems.Count & "|" & .VisibleItems(1).Name & "||" Case xlPageField 'pf.VisibleItems.Count doesn't work on PageFields 'So for PageFields we'll record what that PageField's filter currently displays. '#DEV# Maybe it's quick to iterate through the .VisibleItems collection (if there is one) and count? sLayout_New = sLayout_New & .Name & "|" & .LabelRange.Offset(, 1).Value & "|" & .EnableMultiplePageItems & "||" End Select End With Next pf End Function Function PivotChange_CompareLayout(pt As PivotTable, ByRef sLayout_New As String, ByRef sLayout_Old As String) As String Dim i As Long Dim lng As Long Dim vLayout_Old As Variant Dim vLayout_New As Variant PivotChange_RecordLayout pt, sLayout_New With pt lng = InStr(.Summary, "[Layout]") If lng > 0 Then sLayout_Old = Mid(.Summary, lng + Len("[Layout]"), InStr(.Summary, "[/Layout]") - Len("[Layout]") - lng) If sLayout_Old <> sLayout_New Then vLayout_Old = Split(sLayout_Old, "||") vLayout_New = Split(sLayout_New, "||") For i = 0 To UBound(vLayout_Old) If vLayout_Old(i) <> vLayout_New(i) Then PivotChange_CompareLayout = Split(vLayout_Old(i), "|")(0) Exit For End If Next i End If Else: 'Layout has not yet been recorded. 'Note that we only update .Summary at the end of the main function, ' so we don't wipe the UNDO stack before the PivotChange_UndoCheck routine End If End With End Function Function PivotChange_EliminationCheck(pt As PivotTable, ByRef sPossibles As String) As String 'Check all the visible fields to see if *just one of them alone* has ' neither .AllItemsVisible = True nor .EnableMultiplePageItems = false. ' If that's the case, then by process of elimination, this field ' must be the one that triggered the change, as changes to any of the ' others would have been identified in the code earlier. Dim pf As PivotField Dim lngFields As Long lngFields = 0 On Error Resume Next ' Need this to handle DataFields and 'Values' field For Each pf In pt.PivotFields With pf If .Orientation > 0 Then 'It's not hidden or a DataField If .EnableMultiplePageItems And Not .AllItemsVisible Then If Err.Number = 0 Then 'It *might* be this field lngFields = lngFields + 1 sPossibles = sPossibles & .Name & ";" Else: Err.Clear End If End If End If End With Next On Error GoTo 0 If lngFields = 1 Then PivotChange_EliminationCheck = Left(sPossibles, Len(sPossibles) - 1) End Function Function PivotChange_UndoCheck(pt As PivotTable, sPossibles) As String Dim i As Long Dim dicFields As Object 'This holds a list of all visible pivotfields Dim dicVisible As Object 'This contains a list of all visible PivotItems for a pf Dim varKey As Variant Dim pf As PivotField Dim pi As PivotItem Dim bidentified As Boolean Dim lngVisibleItems As Long Application.EnableEvents = False 'Create master dictionary Set dicFields = CreateObject("Scripting.Dictionary") 'Cycle through all pivotfields, excluding totals For i = 0 To UBound(Split(sPossibles, ";")) - 1 'Create dicVisible: a dictionary for each visible PivotField that contain visible PivotItems Set dicVisible = CreateObject("Scripting.Dictionary") Set pf = pt.PivotFields(Split(sPossibles, ";")(i)) With pf If .Orientation <> xlPageField Then For Each pi In .VisibleItems With pi dicVisible.Add .Name, .Name End With Next pi Else: 'Unfortunately the .visibleitems collection isn't available for PageFields ' eg SomePageField.VisibleItems.Count always returns 1 ' So we'll have to iterate through the pagefield and test the .visible status ' so we can then record just the visible items (which is quite slow) For Each pi In .PivotItems With pi If .Visible Then dicVisible.Add .Name, .Name End If End With Next pi End If 'If .Orientation = xlPageField Then 'Write dicVisible to the dicFields master dictionary dicFields.Add .Name, dicVisible End With Next i Application.Undo For Each varKey In dicFields.keys Set pf = pt.PivotFields(varKey) Set dicVisible = dicFields.Item(varKey) 'Test whether any of the items that were previously hidden are now visible If pf.Orientation <> xlPageField Then For Each pi In pf.VisibleItems With pi If Not dicVisible.exists(.Name) Then PivotChange_UndoCheck = pf.Name bidentified = True Exit For End If End With Next Else 'pf.Orientation = xlPageField lngVisibleItems = dicVisible.Count i = 0 For Each pi In pf.PivotItems With pi If .Visible Then If Not dicVisible.exists(.Name) Then PivotChange_UndoCheck = pf.Name bidentified = True Exit For Else: i = i + 1 'this is explained below. End If End If End With Next ' For non-PageFields, we know that the number of .VisibleItems hasn't changed. ' But we *don't* know that about Pagefields, and an increase in the amount of ' .VisibleItems won't be picked up by our Dictionary approach. ' So we'll check if the overall number of visible items changed If Not bidentified And i > lngVisibleItems Then PivotChange_UndoCheck = pf.Name Exit For End If End If If bidentified Then Exit For Next 'Resore the original settings With Application .CommandBars(14).FindControl(ID:=129).Execute 'Standard Commandbar, Redo command .EnableEvents = True End With End Function End Sub