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

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

0 голосов
/ 14 января 2019

В моей организации ~ 100 отделений. Это строки в моей сводной таблице. Я использую VBA для создания новой сводной таблицы для нового дампа данных каждую неделю. Моя проблема заключается в том, что несколько раз в год удаляется деление или добавляется новое. Моя текущая сводная таблица использует только 15 делений, но на мой код влияют все ~ 100 делений. (мой код ниже показывает только часть для экономии места)

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

With ActiveSheet.PivotTables("PivotTable1").PivotFields("Flex Division - Text")
.PivotItems("03").Visible = False
.PivotItems("04").Visible = False
.PivotItems("05").Visible = False
.PivotItems("07").Visible = False
.PivotItems("1A").Visible = False
.PivotItems("1B").Visible = False
.PivotItems("1C").Visible = False
.PivotItems("1F").Visible = False
.PivotItems("1G").Visible = False
.PivotItems("1J").Visible = False
.PivotItems("1K").Visible = False
.PivotItems("(blank)").Visible = False
End With

Приведенный выше код отфильтровывает неиспользуемые подразделения. Я хочу сделать наоборот. Я хотел бы отфильтровать все разделы, а затем добавить их в разделы, которые я использую. Это позволит избежать будущих корректировок кода.

Ответы [ 2 ]

0 голосов
/ 15 января 2019

Этот код должен делать то, что вам нужно. Чтобы узнать больше о быстрой фильтрации сводных таблиц, посмотрите мой блог на эту тему. 

Option Explicit

Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim vItems As Variant

Set pt = ActiveSheet.PivotTables("PivotTable1")
Set pf = pt.PivotFields("SomeField")

vItems = Array("Item1", "Item2", "Item3")

pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed

With pf

    'At least one item must remain visible in the PivotTable at all times, so make the first
    'item visible, and at the end of the routine, check if it actually  *should* be visible        
    .PivotItems(1).Visible = True

    'Hide any other items that aren't already hidden.
    'Note that it is far quicker to check the status than to change it.
    ' So only hide each item if it isn't already hidden
    For i = 2 To .PivotItems.Count
        If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
    Next i

    'Make the PivotItems of interest visible
    On Error Resume Next 'In case one of the items isn't found
    For Each vItem In vItems
        .PivotItems(vItem).Visible = True
    Next vItem
    On Error GoTo 0

    'Hide the first PivotItem, unless it is one of the items of interest
    On Error Resume Next
    If InStr(UCase(Join(vItemss, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
    If Err.Number <> 0 Then
        .ClearAllFilters
        MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
    End If
    On Error GoTo 0

End With

pt.ManualUpdate = False

End Sub
0 голосов
/ 15 января 2019

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

Option Explicit
Sub Test()

Dim pf As PivotField
Dim pt As PivotTable
Dim pi As PivotItem
Dim keeparr As Variant

Set pt = ActiveSheet.PivotTables("PivotTable1")

'List all the item names that you want to keep in here
keeparr = Array("test1", "test2", "test3")

pt.PivotFields("Flex Division - Test").CurrentPage = "(All)"

For Each pf In pt.PageFields
    If pf = "Flex Division - Text" Then
        For Each pi In pf.PivotItems
            If IsError(Application.Match(pi, keeparr, 0)) Then
                If pi.Visible = True Then pi.Visible = False
            Else
                if pi.Visible = False Then pi.Visible = True
            End If
        Next pi
        Exit For
    End If
Next pf

End Sub

Для тех, кто может избежать циклического прохождения всех PageFields и просто обратиться к нему по имени, пожалуйста, прокомментируйте ниже - я не мог понять это.

...