VBA для подключения слайсеров (ищем улучшения в коде)

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

1. Настройте подчиненную сводную таблицу для каждой из главных сводных таблиц где-нибудь вне поля зрения и поместите интересующее поле в каждую из них как PageField, например:

   

2. Убедитесь, что флажок "Выбрать несколько элементов" не установлен для каждой из подчиненных сводных таблиц:
3. Добавьте слайсер к каждому из этих ведомых устройств. Опять же, они будут где-то вне поля зрения:
4. Подключите каждый из этих срезов к фактическим сводным таблицам, с которых вы должны были начать. (т. е. подключите каждый скрытый срез к его видимой сводной таблице с помощью поля «Соединения отчетов».

Вот тут-то и пригодится умный прием: мы перемещаем слайсер, подключенный к подчиненной таблице PivotTable1 Slave, на основной лист, чтобы пользователь мог щелкнуть по нему. Когда они выбирают элемент, использующий его, он генерирует событие PivotTable_Update для этой подчиненной сводной таблицы PivotTable1, за которой мы следим. А затем мы устанавливаем .PageField этих других подчиненных сводных таблиц в соответствие с .PageField подчиненной таблицы PivotTable1 Slave. И затем происходит еще одна магия: этот единственный выбор в этих подчиненных полях страницы реплицируется в основных сводных таблицах благодаря тем скрытым слайсерам, которые мы настроили ранее. Нет необходимости в VBA. Нет необходимости в медленной итерации. Просто молниеносная синхронизация.

Вот как выглядит вся установка:

... и это будет работать, даже если поле, которое вы хотите фильтровать, не отображается ни в одной из ваших сводок:

Вот код, который этого добивается:

Option Explicit

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

Dim pt As PivotTable
Dim pf As PivotField
Dim sCurrentPage As String
Dim vItem As Variant
Dim vArray As Variant

'########################
'# Change these to suit #
'########################

Const sField As String = "Name"
vArray = Array("PivotTable2 Slave", "PivotTable3 Slave")


If Target.Name = "PivotTable1 Slave" Then
    On Error GoTo errhandler
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    'Find out what item they just selected
    Set pf = Target.PivotFields(sField)
    With pf
        If .EnableMultiplePageItems Then
            .ClearAllFilters
            .EnableMultiplePageItems = False
            sCurrentPage = "(All)"
        Else:
            sCurrentPage = .CurrentPage
        End If
    End With

    'Change the other slave pivots to match. Slicers will pass on those settings
    For Each vItem In vArray
        Set pt = ActiveSheet.PivotTables(vItem)
        Set pf = pt.PivotFields(sField)
        With pf
            If .CurrentPage <> sCurrentPage Then
                .ClearAllFilters
                .CurrentPage = sCurrentPage
            End If
        End With
    Next vItem

errhandler:
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End If

End Sub

Там есть немного кода, чтобы гарантировать, что пользователь не может выбрать более одного элемента в срезе за раз.

Но что, если вы хотите, чтобы пользователь мог выбирать несколько элементов?

Если вы хотите, чтобы пользователь мог выбирать несколько элементов, все становится намного сложнее. Для начала вам необходимо установить для свойства ManualUpdate каждой сводной таблицы значение TRUE, чтобы они не обновлялись при каждом изменении PivotItems. И даже тогда на синхронизацию только одной сводной таблицы, если в ней, скажем, 20 000 элементов, могут уйти минуты. У меня есть хороший пост по следующей ссылке, который я рекомендую вам прочитать, который показывает, сколько времени требуется для выполнения различных действий, когда дело доходит до итерации большого количества PivotItems: http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/

Даже тогда вам придется преодолеть множество других проблем в зависимости от того, что вы делаете. Во-первых, слайсеры действительно замедляют работу. Прочтите мой пост на странице http://dailydoseofexcel.com/archives/2015/11/17/filtering-pivottables-with-vba-deselect-slicers-first/, чтобы узнать больше об этом.

Я нахожусь на завершающей стадии запуска коммерческого дополнения, которое делает многие из этих вещей молниеносно, но до запуска останется как минимум месяц.

Я не уверен, что делаю неправильно. Я разместил свой код ниже, у меня нет никаких ошибок, он просто не обновляет какие-либо другие срезы / поля. При первом тесте слайсер отдела обновил все таблицы один раз, но затем не очистил фильтр и не разрешил другой выбор, что касается слайсера «Месяц», я не заставил его работать вообще. Возможно, мне нужно продублировать каждый элемент, чтобы его можно было отдельно идентифицировать? Как в Dim sCurrentPage As String и Dim sCurrentPage2 As String. Большое вам спасибо за вашу постоянную помощь в этом, я никогда раньше не хотел, чтобы выходные прошли так плохо, когда я работаю с электронной таблицей.

Option Explicit

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

Dim pt As PivotTable
Dim pf As PivotField
Dim sCurrentPage As String
Dim vItem As Variant
Dim vArray As Variant
Dim sField As String

'########################
'# Change these to suit #
'########################

sField = "Department"
vArray = Array("PivotTable2 Slave", "PivotTable3 Slave")


If Target.Name = "PivotTable1 Slave" Then
    On Error GoTo errhandler
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    'Find out what item they just selected
    Set pf = Target.PivotFields(sField)
    With pf
        If .EnableMultiplePageItems Then
            .ClearAllFilters
            .EnableMultiplePageItems = False
            sCurrentPage = "(All)"
        Else:
            sCurrentPage = .CurrentPage
        End If
    End With

    'Change the other slave pivots to match. Slicers will pass on those settings
    For Each vItem In vArray
        Set pt = ActiveSheet.PivotTables(vItem)
        Set pf = pt.PivotFields(sField)
        With pf
            If .CurrentPage <> sCurrentPage Then
                .ClearAllFilters
                .CurrentPage = sCurrentPage
            End If
        End With
    Next vItem

'########################

sField = "Month"
vArray = Array("PivotTable2 Slave2", "PivotTable3 Slave2")


If Target.Name = "PivotTable1 Slave2" Then
    On Error GoTo errhandler
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    'Find out what item they just selected
    Set pf = Target.PivotFields(sField)
    With pf
        If .EnableMultiplePageItems Then
            .ClearAllFilters
            .EnableMultiplePageItems = False
            sCurrentPage = "(All)"
        Else:
            sCurrentPage = .CurrentPage
        End If
    End With

    'Change the other slave pivots to match. Slicers will pass on those settings
    For Each vItem In vArray
        Set pt = ActiveSheet.PivotTables(vItem)
        Set pf = pt.PivotFields(sField)
        With pf
            If .CurrentPage <> sCurrentPage Then
                .ClearAllFilters
                .CurrentPage = sCurrentPage
            End If
        End With
    Next vItem

errhandler:
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End If

End Sub