Фильтрация сводной таблицы на основе двух значений ячеек - PullRequest
Новая
       14

Фильтрация сводной таблицы на основе двух значений ячеек

1 голос
/ 24 мая 2019

Мне нужно отфильтровать сводную таблицу на основе значений в двух разных ячейках.
Каждая ячейка будет фильтровать свое поле в сводной таблице.

Я знаю, как отфильтровать сводную таблицу по значению в одной ячейке.
Однако я не знаю, как добавить второй фильтр. 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xptable As PivotTable
    Dim xpfile As PivotField
    Dim xstr As String
    On Error Resume Next
    If Intersect(target, Range("H6:H7")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xptable = Worksheets("Sheet11").PivotTables("PivotTable2")
    Set xpfile = xptable.PivotFields("FilterField")
    xstr = target.Text
    xpfile.ClearAllFilters
    xpfile.CurrentPage = xstr
    Application.ScreenUpdating = True
End Sub

1 Ответ

1 голос
/ 24 мая 2019

Ваша сводная таблица (Dim xptable As PivotTable) может быть адресована либо по названию, либо по номеру в своем рабочем листе, e. г. 

Set xptable = Worksheets("Given Name of Sheet3").PivotTables("PivotTable3")
Set xptable = Worksheets("Given Name of Sheet3").PivotTables(1)
Set xptable = Sheet3.PivotTables(1) ' or just use codename of Sheet3

Ваше поле фильтра (Dim xpfile As PivotField) может быть адресовано либо как PivotField, либо как PageField. Это почти то же самое, но я предлагаю последнее для лучшей идентификации. е. г. 

Set xpfile = xptable.PivotFields("MyFirstFilterFieldName")
Set xpfile = xptable.PageFields("MyFirstFilterFieldName")
Set xpfile = xptable.PageFields(1)

Чтобы отфильтровать отдельную запись, установите для поля страницы CurrentPage действительный заголовок PivotItem. Вы должны зациклить все его PivotItems, что заголовок существует (в противном случае вы получите ошибку). 

Dim xpitem As PivotItem
With xpfile
    .ClearAllFilters
    For Each xpitem In .PivotItems
        If xpitem.Caption = ... Then
            .CurrentPage = ...
            Exit For
        End If
    Next xpitem

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

Target представляет диапазон ячеек, где что-то было изменено. Так как он может быть намного больше (например, кто-то скопировал большой диапазон из буфера обмена на лист), вы должны проверить Intersect, изменилась ли ваша ячейка, а затем использовать значение отдельной ячейки.

В модуле кода рабочего листа вы ссылаетесь на соответствующий рабочий лист по Me. 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xptable As PivotTable
    Dim xpfile As PivotField
    Dim xpitem As PivotItem

    Set xptable = Sheet3.PivotTables("PivotTable3")

    If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
        Set xpfile = xptable.PageFields(1)
        With xpfile
            .ClearAllFilters
            For Each xpitem In .PivotItems
                If xpitem.Caption = Me.Range("A1").Value Then
                    .CurrentPage = Me.Range("A1").Value
                    Exit For
                End If
            Next xpitem
        End With

    ElseIf Not Intersect(Target, Me.Range("A2")) Is Nothing Then
        ' like above
    End If
End Sub

Если вам нужен один фильтр с несколькими элементами, то вам нужно EnableMultiplePageItems и скрыть все нежелательные сводные элементы - но вы должны убедиться, что всегда остается хотя бы один сводный элемент видимый, е. г. 

Dim AtLeastOneVisible As Boolean
With myPivotTable.PageFields(1)
    .ClearAllFilters
    .EnableMultiplePageItems = True

    AtLeastOneVisible = False
    For Each myPivotItem In .PivotItems
        If myPivotItem .Caption = ... Or myPivotItem .Caption = ... Then
            AtLeastOneVisible = True
            Exit For
        End If
    Next myPivotItem

    If AtLeastOneVisible Then
        For Each myPivotItem In .PivotItems
            If myPivotItem .Caption <> ... And myPivotItem .Caption <> ... Then
                pi.Visible = False
            End If
        Next myPivotItem 
    End If
End With
...