Филтриране на множество обобщени таблици въз основа на падащи селекции с помощта на VBA

Ето няколко предложения.

1. Каква версия на Excel имате? Може просто да заобиколите проблема, ако използвате Excel 2010 или по-нова версия, тъй като можете просто да настроите Slicer в полето за дата и след това да свържете този Slicer към всяка обобщена таблица, която искате да синхронизирате. В по-късните версии можете да направите същото, като използвате специализиран слайсер, наречен 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 (т.е. полета, преместени в панела с филтри), както е показано на следната екранна снимка:

Така че, ако искате да използвате следния код, ще трябва да плъзнете вашите полета за месец в обобщената таблица като RowField, така:

Ако приемем, че това няма да създаде проблеми, тогава можете да използвате следния код:

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 на вашите падащи менюта за валидиране на данни и след това посочих тези имена в кода. Ще трябва да направите същото във вашия основен лист.

Ако не искате да промените оформлението на обобщената си таблица, тогава заобиколно решение е да добавите TimeLine в полето за месеца и да го промените програмно чрез падащите менюта. След това ще актуализира обобщената таблица. Ето как изглежда това:

Обърнете внимание, че полето Месец не изглежда като към него е приложен филтър, но го прави... както се вижда от общите суми, които се показват в обобщената таблица.

Ето модифицирания код за управляваната от времевата линия версия:

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. Оказва се, че това не е просто ужасно неефективно, но също така изисква временно да промените числовия си формат на полето Месец от формат MMM-YY на формат DD-MM-YY или подобен, защото в противен случай VBA може да тълкува погрешно годината като на ден и след това използвайте текущата година като година. Така че, ако вашият PivotItem е OCT-15, тогава VBA интерпретира това като 15 октомври 2016 г. (текущата година, докато пиша това) вместо 1 октомври 2015 г. Гадно.

Така че бих посъветвал да избягвате итерациите и или да промените формата на обобщената си таблица и да използвате моя първи подход, или да добавите TimeLine и да използвате моя втори подход.