如何使用 VBA 更新切片器缓存
How to update slicer cache with VBA
我根据用户选择在切片器上使用 Excel VBA 到 hide/show 元素。
我有以下代码:
Private Sub removeFilterWithSlicer()
Dim slicerCache As slicerCache
Set slicerCache = ThisWorkbook.SlicerCaches("Slicer_Channel1")
slicerCache.SlicerItems("A").Selected = False
slicerCache.SlicerItems("B").Selected = False
slicerCache.SlicerItems("C").Selected = False
slicerCache.SlicerItems("D").Selected = False
slicerCache.SlicerItems("E").Selected = False
slicerCache.SlicerItems("F").Selected = False
End Sub
其中 A、B 等是切片器中元素的名称。我已经交叉检查了切片器缓存的名称 ("Slicer_Channel1")。问题是元素没有像预期的那样被取消选择。当我调试代码时,我发现每个元素都被一个一个地取消选择但是一旦我到达过程结束即 End Sub,它们都会回到选中状态。
有什么指点吗?
至少要 select编辑一个。使用鼠标 selecting 时的工作方式相同。你不能 un-select all
此代码展示了如何在名为 vSelection 的数组上筛选切片器。
Option Explicit
Sub FilterSlicer()
Dim slr As Slicer
Dim sc As SlicerCache
Dim si As SlicerItem
Dim i As Long
Dim vItem As Variant
Dim vSelection As Variant
Set sc = ActiveWorkbook.SlicerCaches("Slicer_ID")
'Set sc = slr.SlicerCache
vSelection = Array("B", "C", "E")
For Each pt In sc.PivotTables
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
Next pt
With sc
'At least one item must remain visible in the Slicer at all times, so make the first
'item visible, and at the end of the routine, check if it actually *should* be visible
.SlicerItems(1).Selected = True
'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .SlicerItems.Count
If .SlicerItems(i).Selected Then .SlicerItems(i).Selected = False
Next i
'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vSelection
.SlicerItems(vItem).Selected = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vSelection, "|")), UCase(.SlicerItems(1).Name)) = 0 Then .SlicerItems(1).Selected = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Slicer, so I have cleared the filter"
End If
On Error GoTo 0
End With
For Each pt In sc.PivotTables
pt.ManualUpdate = False
Next pt
End Sub
我根据用户选择在切片器上使用 Excel VBA 到 hide/show 元素。
我有以下代码:
Private Sub removeFilterWithSlicer()
Dim slicerCache As slicerCache
Set slicerCache = ThisWorkbook.SlicerCaches("Slicer_Channel1")
slicerCache.SlicerItems("A").Selected = False
slicerCache.SlicerItems("B").Selected = False
slicerCache.SlicerItems("C").Selected = False
slicerCache.SlicerItems("D").Selected = False
slicerCache.SlicerItems("E").Selected = False
slicerCache.SlicerItems("F").Selected = False
End Sub
其中 A、B 等是切片器中元素的名称。我已经交叉检查了切片器缓存的名称 ("Slicer_Channel1")。问题是元素没有像预期的那样被取消选择。当我调试代码时,我发现每个元素都被一个一个地取消选择但是一旦我到达过程结束即 End Sub,它们都会回到选中状态。
有什么指点吗?
至少要 select编辑一个。使用鼠标 selecting 时的工作方式相同。你不能 un-select all
此代码展示了如何在名为 vSelection 的数组上筛选切片器。
Option Explicit
Sub FilterSlicer()
Dim slr As Slicer
Dim sc As SlicerCache
Dim si As SlicerItem
Dim i As Long
Dim vItem As Variant
Dim vSelection As Variant
Set sc = ActiveWorkbook.SlicerCaches("Slicer_ID")
'Set sc = slr.SlicerCache
vSelection = Array("B", "C", "E")
For Each pt In sc.PivotTables
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
Next pt
With sc
'At least one item must remain visible in the Slicer at all times, so make the first
'item visible, and at the end of the routine, check if it actually *should* be visible
.SlicerItems(1).Selected = True
'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .SlicerItems.Count
If .SlicerItems(i).Selected Then .SlicerItems(i).Selected = False
Next i
'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vSelection
.SlicerItems(vItem).Selected = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vSelection, "|")), UCase(.SlicerItems(1).Name)) = 0 Then .SlicerItems(1).Selected = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Slicer, so I have cleared the filter"
End If
On Error GoTo 0
End With
For Each pt In sc.PivotTables
pt.ManualUpdate = False
Next pt
End Sub