取消过滤数据透视表中的所有行数据，然后过滤特定值

Question

我的组织有大约 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

上面的代码过滤掉了不使用的分区。我想做相反的事情。我想取消过滤所有部门，然后重新添加我使用的部门。这将避免将来的代码调整。

Answer 1

所以这里的第一个问题是，您不能在过滤器中创建一个没有项目的数据透视表 - 相反，创建一个包含您每次要保留的所有项目的数组，并在一个循环中检查该数组 - 如果项目在数组中，它将确保它是可见的。如果它不在那里，它会隐藏它：

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 并仅按名称解决的人，请在下面发表评论 - 我无法弄清楚。

Answer 2

此代码应该可以满足您的需求。要了解有关快速过滤数据透视表的更多信息，请查看该主题的 my blogpost。

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