我在Excel中的数据透视表和数据透视表上操作了三个切片器。但是，当按下其中一个切片器时，必须清除另外两个切片器放置的过滤器，以确保只有一个切片器同时运行。我认为必须使用VBA解决此问题，先听一下单击然后执行代码，除此之外我不知道，因为我以前从未使用过Excel或VBA。
有人对我将如何执行此操作有任何建议吗？
最佳答案
弄清楚切片器的单击确实非常棘手，因为单击切片器引发的唯一应用程序事件是PivotTable_Update事件。此事件告诉我们切片器连接到哪个PivotTable，但不会过滤该PivotTable中的哪个字段。因此，如果您有多个连接到数据透视表的振荡器，则无法确定是单击了哪一个。
我想出了一个非常复杂的解决方法，我在http://dailydoseofexcel.com/archives/2014/07/10/what-caused-that-pivottableupdate-episode-iv/上发布了该解决方法，它将带您进入该方法：它将告诉您数据透视表中的哪个字段刚刚更新，然后您只需遍历连接到的所有切片器即可。该数据透视表并清除它们（如果它们没有相同的源名称）。
我会看看我是否可以在适当的时候编写一些代码，但是我现在很忙，所以不能保证有一个快速的解决方案。
请注意，您可以将宏直接分配给切片器，该切片器在用户单击时触发，然后您可以从中确定切片器。但是不幸的是，该宏会干扰切片器本身：用户不再能够实际操作切片器来实际更改任何内容。
-更新-
这是一些您想要执行的代码。这里有很多不同的模块，因为例程代码调用了我使用的许多其他通用例程。它的核心是例程，该例程确定要更新数据透视表的哪个特定字段，而不必关心是否过滤了多个字段。
您可以使用此事件处理程序来调用它，该事件处理程序在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: [email protected] or [email protected]
' 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
' e.g. 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
关于excel - 按下切片器时在Excel中禁用其他切片器，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/33152087/