我有一个数据透视表,该数据透视表由日期归档的数据透视切片器过滤。 在另一张纸上,我有一个来自单元格A1:A12的12个月日期范围示例。 我有遍历切片器的代码,并尝试将切片器中的内容与范围进行匹配。理想情况下,我希望切片器仅选择存在于A1:A12范围内的值。下面的代码可以运行,但是一旦循环终止就选择了所有内容。
有什么想法吗?
Sub DateSelect()
Dim ws As Worksheet
Dim i As Integer, iLookupColumn As Integer
Dim sl As SlicerCache
Dim sDate As String
Set sl = ThisWorkbook.SlicerCaches("Slicer_Month_and_Year")
Set ws = ThisWorkbook.Sheets("Macro")
For i = 1 To sl.SlicerItems.Count
sDate = sl.SlicerItems(i).Name
If IsError(Application.Match(sDate, ws.Range(ws.Cells(1, 14), ws.Cells(13, 14)), 0)) Then
ThisWorkbook.SlicerCaches("Slicer_Month_and_Year").SlicerItems(i).Selected = False
Else
ThisWorkbook.SlicerCaches("Slicer_Month_and_Year").SlicerItems(i).Selected = True
End If
Next i
End Sub
答案 0 :(得分:1)
这应该有效:
Option Explicit
Sub filterSlicers()
Dim i As Long, SI As SlicerItem, SC As SlicerCache, PvT As PivotTable, C As Range, Cell As Range, ws As Worksheet
Dim DictFilter As Scripting.Dictionary 'You need Microsoft Scripting Runtime for this to work
For Each PvT In ThisWorkbook.Sheets("TheSheetContainingThePivotTables").PivotTables 'this will improve a lot the performance
PvT.ManualUpdate = True
Next PvT
Set ws = ThisWorkbook.Sheets("Macro")
Set C = ws.Range("A1:A12") 'change your range
Set DictFilter = New Scripting.Dictionary 'initialize the dictionary
For Each Cell In C
DictFilter.Add Cell.Value, 1 'store the values you want to filter on the dictionary
Next Cell
Set SC = ThisWorkbook.SlicerCaches("Slicer_Month_and_Year")
SC.ClearAllFilters
For Each SI In SC.VisibleSlicerItems
Set SI = SC.SlicerItems(SI.Name)
If DictFilter.Exists(SI.Name) Then
SI.Selected = True
Else
SI.Selected = False
End If
Next
For Each PvT In ThisWorkbook.Sheets("TheSheetContainingThePivotTables").PivotTables 'return the automatic update to the pivot tables
PvT.ManualUpdate = False
Next PvT
End Sub
请注意,我已经添加了一些额外的性能代码(关闭了使用切片器的数据透视表的手动更新)