Excel VBA - Privot table filter multiple criteria

前端 未结 3 1287
北海茫月
北海茫月 2021-01-12 23:28

I am trying to filter a pivot table with multiple criteria. I\'ve check other posts, but I am getting the error \"AutoFiler method of Range class failed\" when running:

3条回答
  •  时光说笑
    2021-01-13 00:20

    I was just trying to do a similar thing, and got an error about not being able to adjust visibility.

    PTItm.Visible = False
    

    Looking into it, it had something to do with the kind of query (OLAP or not I think or maybe because I set the pivot up as a table view). Anyway, I had to adjust Shai's great idea a little to make it work. I thought I'd share this to save others, who come across this thread in the future, some time fiddling with odd errors. The key was to use another array and .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
    

    Edit: I forgot to mention that this code assumes, that no filters were applied before. This works fine for me but may not be helpful for everyone.

提交回复
热议问题