Excel VBA - 数据透视表过滤多个条件答案

【问题标题】：Excel VBA - Pivot table filter multiple criteriaExcel VBA - 数据透视表过滤多个条件
【发布时间】：2017-02-28 10:18:26
【问题描述】：

我正在尝试使用多个条件过滤数据透视表。我检查了其他posts，但我收到了错误

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

有没有更有效的方法？

【问题讨论】：

如果您尝试使用常规方法过滤数据透视表，您会发现当您尝试执行此操作时它是灰色的。数据透视表已被过滤，这就是您记录的代码有效但您编写的代码无效的原因
谢谢伯恩斯先生。但是有没有办法用一系列值过滤枢轴。我有 400 多个 PivotItems，我只需要其中的 15 个可见
@Selrac 试试下面的代码来过滤大集合，使用数组

标签： excel vba

【解决方案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

【讨论】：

【解决方案2】：

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

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

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

代码示例

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

【讨论】：

【解决方案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

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

【讨论】：