Обновите фильтры сводной таблицы, используя диапазон дат из 2 ячеек и имя из другой ячейки - PullRequest
Новая
       14

Обновите фильтры сводной таблицы, используя диапазон дат из 2 ячеек и имя из другой ячейки

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

У меня есть панель управления Excel, которая обновляет таблицы и диаграммы при изменении имени и даты в определенных ячейках, но мне также нужны 2 сводные таблицы для обновления с использованием этих ячеек.Меня зовут D2: G2, а ячейки диапазонов дат: От: P2 до: R2

Я пробовал различные найденные в сети решения для обновления диапазонов сводных дат, но ни одно из них не работает при попытке связать ихс кодом обновления имени.

Пока у меня есть: 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim PTable As PivotTable
    Dim PField As PivotField
    Dim Str As String

    On Error Resume Next
    If Intersect(Target, Range("D2:G2")) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
    Set PTable = Worksheets("Stats").PivotTables("PivotTable1")
    Set PField = PTable.PivotFields("BM attendees")
    Str = Target.Text
    PField.ClearAllFilters
    PField.CurrentPage = Str
    Application.ScreenUpdating = True
End Sub

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

1 Ответ

0 голосов
/ 09 мая 2019

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

Вы всегда должны убедиться, что хотя бы 1 пивотит остается видимым.

Вы также должны убедиться, что данное имя участника (в Target.Text) соответствует любому элементу сводки, прежде чем пытаться переключить текущую страницу на этого участника. 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim PTable As PivotTable
    Dim PField As PivotField
    Dim PItem As PivotItem
    Dim AttendeeName As Range
    Dim DateFrom As Range, DateTo As Range
    Dim AtLeastItemRemainsVisible As Boolean

    Set AttendeeName = ActiveSheet.Range("D2")
    Set DateFrom = ActiveSheet.Range("D2")
    Set DateTo = ActiveSheet.Range("R2")

    Set PTable = Worksheets("Stats").PivotTables(1) ' or ("PivotTable1")

    Application.ScreenUpdating = False
    'Application.EnableEvents = False

    ' Select 1 attendee name as single filter page:
    If Not Intersect(Target, AttendeeName) Is Nothing Then
        Set PField = PTable.PageFields(1) ' or ("BM attendees")
        PField.ClearAllFilters
        PField.EnableMultiplePageItems = False
        For Each PItem In PField.PivotItems
            If PItem.Name = Target.Text Then
                PField.CurrentPage = Target.Text
            End If
        Next PItem

    ' select all valid dates between two given dates:
    ElseIf Not Intersect(Target, Union(DateFrom, DateTo)) Is Nothing Then
        Set PField = PTable.PageFields(2)
        PField.ClearAllFilters
        PField.EnableMultiplePageItems = True

        ' at least 1 PivotItem must remain visible:
        AtLeastItemRemainsVisible = False
        For Each PItem In PField.PivotItems
            If CDate(PItem.Name) >= CDate(DateFrom) _
                And CDate(PItem.Name) <= CDate(DateTo) Then
                AtLeastItemRemainsVisible = True
                Exit For
            End If
        Next PItem

        If AtLeastItemRemainsVisible Then
            For Each PItem In PField.PivotItems
                PItem.Visible = _
                    CDate(PItem.Name) >= CDate(DateFrom) _
                    And CDate(PItem.Name) <= CDate(DateTo)
            Next PItem
        End If
    End If

    'Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

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

Private Sub DateFilter()
    With ActiveSheet.PivotTables(1).RowFields(1)
        .ClearAllFilters

        ' between two dates:
        .PivotFilters.Add2 _
            Type:=xlDateBetween, _
            Value1:=CStr(DateSerial(Year(Date) - 1, Month(Date), Day(Date))), _
            Value2:=CStr(Date), _
            WholeDayFilter:=True

        ' another example, please refer to macro recorder for special date ranges:
        .PivotFilters.Add2 _
            Type:=xlDateThisYear

    End With
End Sub
...