Excel VBA - 数据透视表筛选多个条件

Question

我正在尝试过滤具有多个条件的数据透视表。 我检查了其他帖子，但我收到错误

Range 类的 AutoFiler 方法失败

运行时：

Range("g41").Select
Selection.AutoFilter field:=1, Criteria1:=Array( _
    "101", "103"), Operator:=xlFilterValues

以下工作，但有相当多的项目来过滤真/假

With ActiveSheet.PivotTables("PivotTable3").PivotFields("Value")
    .PivotItems("101").Visible = True
    .PivotItems("103").Visible = True
    .PivotItems("105").Visible = False
End With

有没有更有效的方法？

Answer 1

你可以试试下面的代码：

Option Explicit

Sub FilterPivotItems()

Dim PT          As PivotTable
Dim PTItm       As PivotItem
Dim FiterArr()  As Variant

' use an array to select the items in the pivot filter you want to keep visible
FiterArr = Array("101", "105", "107")

' set the Pivot Table
Set PT = ActiveSheet.PivotTables("PivotTable3")

' loop through all Pivot Items in "Value" Pivot field
For Each PTItm In PT.PivotFields("Value").PivotItems
    If Not IsError(Application.Match(PTItm.Caption, FiterArr, 0)) Then ' check if current item is not in the filter array
        PTItm.Visible = True
    Else
        PTItm.Visible = False
    End If
Next PTItm

End Sub

Answer 2

这些问题有一个非常简单的解决方案。

只需使用方法通过“SLICER”（和 VBA 代码）选择项目。

有关更多详细信息，请使用记录宏选项。

代码示例

ActiveWorkbook.SlicerCaches("Slicer_RS_YM").SlicerItems("Item1Name").Selected = True ' 包括 ActiveWorkbook.SlicerCaches("Slicer_RS_YM").SlicerItems("Item2Name").Selected = False ' 排除

Answer 3

我只是试图做类似的事情，但遇到了无法调整可见性的错误。

PTItm.Visible = False

调查一下，它与查询类型有关（我认为是否为 OLAP，或者可能是因为我将数据透视设置为表视图）。 不管怎样，我不得不稍微调整一下 Shai 的好主意才能让它发挥作用。 我想我会分享这个来拯救其他人，他们将来遇到这个线程，有时间摆弄奇怪的错误。 关键是使用另一个数组和 .VisibleItemsList。

Sub FilterPivotItems()

Dim PT          As PivotTable
Dim PTItm       As PivotItem
Dim FiterArr()  As Variant
Dim NewFilterList() As Variant
ReDim Preserve NewFilterList(0) 'I still haven't figured out how to avoid this double dim'ing, sorry

' use an array to select the items in the pivot filter you want to keep visible
FiterArr = Array("[POSched].[Inspection Plan].&", "[POSched].[Inspection Plan].&[DEFAULT]") '2 Items here, the first one means empty i.e. ""

' set the Pivot Table
Set PT = ThisWorkbook.Sheets("Prisma").PivotTables("SequenceOverview")

' loop through all Pivot Items in "Value" Pivot field
For Each PTItm In PT.PivotFields("[POSched].[Inspection Plan].[Inspection Plan]").PivotItems
    If IsError(Application.Match(PTItm.Value, FiterArr, 0)) Then ' check if current item is not in the filter array
        NewFilterList(UBound(NewFilterList)) = PTItm.Value 'Make a new array to use later
        ReDim Preserve NewFilterList(UBound(NewFilterList) + 1)
    End If
Next PTItm

ThisWorkbook.Sheets("Prisma").PivotTables("SequenceOverview").PivotFields("[POSched].[Inspection Plan].[Inspection Plan]").VisibleItemsList = NewFilterList

End Sub

编辑：我忘了提到这段代码假设之前没有应用任何过滤器。 这对我来说很好，但可能对每个人都没有帮助。