Slicer не будет фильтровать связанную таблицу, если не нажать на - PullRequest
0 голосов
/ 09 января 2020

Я новичок в VBA и Excel - у меня большая таблица с длинным списком оборудования. Слишком много категорий, чтобы прокрутить весь слайсер, поэтому я использую сводную таблицу в качестве строки поиска, как в в этом примере . Затем у меня есть фрагмент кода VBA для использования этого слайсера, который связан как с фильтром / поиском в сводной таблице, так и с обычной таблицей, поэтому он будет скрывать в обычной таблице все, что не выбрано в слайсере.


    Option Explicit

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim sLastUndoStackItem As String
Dim sc          As SlicerCache
Dim si          As SlicerItem
Dim vItems      As Variant
Dim i           As Long
Dim lo          As ListObject
Dim lc          As ListColumn
Dim sTest       As String

Const sPivot As String = "PivotTable3" '<= Change name as appropriate
Const sTable As String = "Table1" '<= Change name as appropriate

If Target.Name = sPivot Then
    On Error Resume Next 'in case the undo stack has been wiped or doesn't exist
    sLastUndoStackItem = Application.CommandBars(14).FindControl(ID:=128).List(1) 'Standard Commandbar, undo stack
    'The above line doesn't seem to work in my version of O365 so we'll use the English language backup
    If sLastUndoStackItem = "" Then sLastUndoStackItem = Application.CommandBars("Standard").Controls("&Undo").List(1)
    On Error GoTo 0

    If sLastUndoStackItem = "Filter" Or sLastUndoStackItem = "Slicer Operation" Then

        Set lo = Range(sTable).ListObject

        For Each sc In ActiveWorkbook.SlicerCaches
            On Error Resume Next
            sTest = sc.PivotTables(1).Name
            On Error GoTo 0
            If sTest = sPivot Then
                Set lc = lo.ListColumns(sc.SourceName)
                If sc.FilterCleared Then
                    lo.Range.AutoFilter Field:=lc.Index
                Else
                    ReDim vItems(1 To 1)
                    For Each si In sc.SlicerItems
                        If si.Selected Then
                            i = i + 1
                            ReDim Preserve vItems(1 To i)
                            vItems(i) = si.Name
                        End If
                    Next si

                    lo.Range.AutoFilter Field:=lc.Index, Criteria1:=vItems, Operator:=xlFilterValues
                    ReDim vItems(1 To 1)
                End If
            End If
        Next sc
    End If
End If


End Sub

Проблема в том, что этот код будет запускаться только при фактическом нажатии на слайсере, что означает, что если вы используете поиск в сводной таблице, вам все равно придется прокручивать список слайсеров, чтобы заставить работать фильтрацию. Можно ли как-нибудь активировать этот код слайсера непосредственно из панели поиска сводной таблицы?

Редактировать: я получил его, используя это:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sc As SlicerCache, si As SlicerItem
If Target.Address = "$KE12" Then                        ' cell to monitor
    Set sc = ActiveWorkbook.SlicerCaches("Slicer_Sub_Category_Master")      ' desired slicer
    sc.ClearAllFilters
    For Each si In sc.SlicerItems
        If si.Caption = CStr(Target) Then
            si.Selected = True
        Else
            si.Selected = False
        End If
    Next
End If
End Sub

, который проверяет значение E12 (мой ячейка поиска сводной таблицы) и использует это значение для установки среза. Затем приведенный выше код работает для фильтрации связанной регулярной таблицы.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...