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

編輯：我忘了提到這段代碼假設之前沒有應用任何過濾器。 這對我來說很好，但可能對每個人都沒有幫助。