Фильтрация нескольких сводных таблиц на основе выпадающего списка с использованием VBA

Вот несколько предложений.

1. Какая у вас версия Экселя? Вы можете просто обойти эту проблему при использовании Excel 2010 или более поздней версии, потому что вы можете просто настроить слайсер в поле даты, а затем подключить этот слайсер к любым сводным таблицам, которые вы хотите синхронизировать. В более поздних версиях вы можете сделать то же самое, используя специализированный слайсер под названием Timeline. Некоторое время назад я написал соответствующий пост по следующей ссылке, которая может представлять интерес: http://dailydoseofexcel.com/archives/2014/08/16/sync-pivots-from-dropdown/

2. #P3# <блочная цитата> #P4#

Это может быть ваша проблема. Недавно я столкнулся с некоторыми похожими проблемами и обошел их, преобразовав дату, которую я хотел отфильтровать Pivot, в DateSerial (чтобы обойти «несовместимость» даты в США и за пределами США), а затем преобразовал этот DateSerial как Long со следующим строка кода:

CLng(DateSerial(Год(vItem), Месяц(vItem), День(vItem)))

Вашему коду может понадобиться что-то вроде этого. Если вы измените свой вопрос, включив в него точный код, который не работает, я посмотрю.

3. Проверьте этот недавний вопрос SO, на который я ответил: его можно легко изменить, чтобы делать то, что вы хотите. Фильтрация сводной таблицы с помощью vba

---Изменить---

Самый эффективный способ программно отфильтровать сводные данные по диапазону дат — использовать встроенную функциональность Дата между, т. е. вот эту штуку:

Единственная проблема заключается в том, что эта функция недоступна для PageFields (т. е. полей, перетаскиваемых на панель «Фильтры»), как показано на следующем снимке экрана:

Предполагая, что это не вызовет никаких проблем, вы можете использовать следующий код:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim pt As PivotTable
Dim vItem As Variant
Dim rFrom As Range
Dim rTo As Range

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set rFrom = Range("dvFrom")
Set rTo = Range("dvTo")

If Not Intersect(Target, rFrom) Is Nothing Or Not Intersect(Target, rTo) Is Nothing Then
    If rFrom < rTo Then
        For Each vItem In Array("PivotTable1", "PivotTable2") 'Change PivotTable names as appropriate
            Set pt = Sheet1.PivotTables(vItem) 'Change Sheet as appropriate
            With pt.PivotFields("Month")
                .ClearAllFilters
                .PivotFilters.Add2 _
                    Type:=xlDateBetween, _
                    Value1:=CLng(DateSerial(Year(rFrom), Month(rFrom), Day(rFrom))), _
                    Value2:=CLng(DateSerial(Year(rTo), Month(rTo), Day(rTo)))
                    'I use "CLng(DateSerial" because otherwise VBA may get confused
                    ' if the user's Excel i set to a non US dateformat.
            End With
        Next vItem
    End If
End If

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Обратите внимание, что я присвоил имена dvFrom и dvTo раскрывающимся спискам проверки данных, а затем сослался на эти имена в коде. Вам нужно будет сделать то же самое в мастер-листе.

Если вы не хотите менять макет сводной таблицы, обходной путь — добавить временную шкалу в поле месяца и программно изменить ее с помощью раскрывающихся списков. Затем он обновит сводную таблицу. Вот как это выглядит:

Обратите внимание, что поле «Месяц» не выглядит так, будто к нему применен фильтр, но это так... о чем свидетельствуют итоги, отображаемые в сводной таблице.

Вот измененный код для версии, управляемой временной шкалой:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim vItem As Variant
Dim rFrom As Range
Dim rTo As Range
Dim lFrom As Long
Dim lTo As Long
Dim dte As Date

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set rFrom = Range("dvFrom")
Set rTo = Range("dvTo")

If Not Intersect(Target, rFrom) Is Nothing Or Not Intersect(Target, rTo) Is Nothing Then
    lFrom = CLng(DateSerial(Year(rFrom), Month(rFrom), Day(rFrom)))
    lTo = CLng(DateSerial(Year(rTo), Month(rTo), Day(rTo)))
    If lFrom < lTo Then
        For Each vItem In Array("NativeTimeline_Month", "NativeTimeline_Month1") 'Adjust timeline names as neccessary
            ActiveWorkbook.SlicerCaches(vItem).TimelineState. _
                SetFilterDateRange lFrom, lTo
        Next vItem
    End If
End If


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With


End Sub

И это оставляет нас с вашим первоначальным подходом — перебором PivotItems. Оказывается, это не только ужасно неэффективно, но также требует, чтобы вы временно изменили числовой формат поля «Месяц» с формата МММ-ГГ на формат ДД-ММ-ГГ или аналогичный, потому что в противном случае VBA может неправильно интерпретировать год как в день, а затем используйте текущий год в качестве года. Итак, если ваш PivotItem - OCT-15, тогда VBA интерпретирует это как 15 октября 2016 года (текущий год, когда я это набираю) вместо 1 октября 2015 года. Неприятно.

Поэтому я бы посоветовал избегать итераций и либо изменить формат сводной таблицы и использовать мой первый подход, либо добавить временную шкалу и использовать мой второй подход.