Фильтрация Pivot Slicer по диапазону значений

Question

У меня есть сводная таблица, которая фильтруется с помощью сводного среза с полем даты. На другом листе у меня есть 12-месячный пример диапазона дат из ячейки A1: A12. У меня есть код, который проходит через слайсер и пытается сопоставить что в слайсере по сравнению с диапазоном. В идеале я хотел бы, чтобы слайсер затем выбирал только те значения, которые существуют в диапазоне 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 

Answer 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

Обратите внимание, что я добавил дополнительный код для повышения производительности (отключив обновление вручную для сводных таблиц, использующих срез)