如何在 Excel 中使用多个切片器 link 一个 Table 和一个 Pivot Table?
How to link a Table and a Pivot Table using more than one slicer in Excel?
我在使用切片器 link table 和数据透视表 Table 时遇到了同样的问题。 [jeffreyweir] 提供的答案非常完美!但就我而言,我需要使用 3 个或更多不同切片器的解决方案。
可以通过以下link找到初始解决方案:
提前很多次,我希望我以正确的方式遵守了这个奇妙网站的规则! ;-)
好的,所以我修改了代码,使其只需要 PivotTable 切片器,并使用这些切片器设置直接过滤 Table。请注意,您需要更改代码中的以下行以匹配 Table 和 PivotTable 的名称:
Const sPivot As String = "PivotTable1" '<= Change name as appropriate
Const sTable As String = "Table1" '<= Change name as appropriate
此代码必须粘贴到属于作品sheet的sheet模块中,其中Tables/PivotTables相关的是:
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim sLastUndoStackItem As String
Dim sc As SlicerCache
Dim si As SlicerItem
Dim vItems As Variant
Dim i As Long
Dim lo As ListObject
Dim lc As ListColumn
Dim sTest As String
Const sPivot As String = "PivotTable1" '<= Change name as appropriate
Const sTable As String = "Table1" '<= Change name as appropriate
If Target.Name = sPivot Then
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
'The above line doesn't seem to work in my version of O365 so we'll use the English language backup
If sLastUndoStackItem = "" Then sLastUndoStackItem = Application.CommandBars("Standard").Controls("&Undo").List(1)
On Error GoTo 0
If sLastUndoStackItem = "Filter" Or sLastUndoStackItem = "Slicer Operation" Then
Set lo = Range(sTable).ListObject
For Each sc In ActiveWorkbook.SlicerCaches
On Error Resume Next
sTest = sc.PivotTables(1).Name
On Error GoTo 0
If sTest = sPivot Then
Set lc = lo.ListColumns(sc.SourceName)
If sc.FilterCleared Then
lo.Range.AutoFilter Field:=lc.Index
Else
ReDim vItems(1 To 1)
For Each si In sc.SlicerItems
If si.Selected Then
i = i + 1
ReDim Preserve vItems(1 To i)
vItems(i) = si.Name
End If
Next si
lo.Range.AutoFilter Field:=lc.Index, Criteria1:=vItems, Operator:=xlFilterValues
ReDim vItems(1 To 1)
End If
End If
Next sc
End If
End If
End Sub
它正在运行:
对于数据 table 与数据中心 table 不同的 sheet 的人,只需更改
Set lo = Range(sTable).ListObject
至
Set lo = Sheets("table_sheet_name").Range(sTable).ListObject
并将代码存储在枢轴 table sheet 模块中。
我在使用切片器 link table 和数据透视表 Table 时遇到了同样的问题。 [jeffreyweir] 提供的答案非常完美!但就我而言,我需要使用 3 个或更多不同切片器的解决方案。
可以通过以下link找到初始解决方案:
提前很多次,我希望我以正确的方式遵守了这个奇妙网站的规则! ;-)
好的,所以我修改了代码,使其只需要 PivotTable 切片器,并使用这些切片器设置直接过滤 Table。请注意,您需要更改代码中的以下行以匹配 Table 和 PivotTable 的名称:
Const sPivot As String = "PivotTable1" '<= Change name as appropriate
Const sTable As String = "Table1" '<= Change name as appropriate
此代码必须粘贴到属于作品sheet的sheet模块中,其中Tables/PivotTables相关的是:
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim sLastUndoStackItem As String
Dim sc As SlicerCache
Dim si As SlicerItem
Dim vItems As Variant
Dim i As Long
Dim lo As ListObject
Dim lc As ListColumn
Dim sTest As String
Const sPivot As String = "PivotTable1" '<= Change name as appropriate
Const sTable As String = "Table1" '<= Change name as appropriate
If Target.Name = sPivot Then
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
'The above line doesn't seem to work in my version of O365 so we'll use the English language backup
If sLastUndoStackItem = "" Then sLastUndoStackItem = Application.CommandBars("Standard").Controls("&Undo").List(1)
On Error GoTo 0
If sLastUndoStackItem = "Filter" Or sLastUndoStackItem = "Slicer Operation" Then
Set lo = Range(sTable).ListObject
For Each sc In ActiveWorkbook.SlicerCaches
On Error Resume Next
sTest = sc.PivotTables(1).Name
On Error GoTo 0
If sTest = sPivot Then
Set lc = lo.ListColumns(sc.SourceName)
If sc.FilterCleared Then
lo.Range.AutoFilter Field:=lc.Index
Else
ReDim vItems(1 To 1)
For Each si In sc.SlicerItems
If si.Selected Then
i = i + 1
ReDim Preserve vItems(1 To i)
vItems(i) = si.Name
End If
Next si
lo.Range.AutoFilter Field:=lc.Index, Criteria1:=vItems, Operator:=xlFilterValues
ReDim vItems(1 To 1)
End If
End If
Next sc
End If
End If
End Sub
它正在运行:
对于数据 table 与数据中心 table 不同的 sheet 的人,只需更改
Set lo = Range(sTable).ListObject
至
Set lo = Sheets("table_sheet_name").Range(sTable).ListObject
并将代码存储在枢轴 table sheet 模块中。