VBA 过滤数据透视表，其中包含命名范围中的通配符数组

Question

我目前正在努力让动态过滤器发挥作用。

初始情况：数据透视表，我需要在其中过滤多个不同的单词。 它总是这样构建的：

7.06610.14.0 EDR-E -> 我需要过滤一些特定的单词

7.03083.11.0 EAM

7.05569.18.0 雷格尔克拉佩

7.09451.00.0 EAM-S

...

我为需要过滤的单词创建了一个命名范围。

我可以将它们全部放入带有通配符的数组中，但系统不会过滤。

这是填充我的数组的代码：

Dim myArray() As Variant
Dim myNr As Long

Bereich = Range("_Bereich") 'Named range
myArray = Range("_" & Bereich & "Filter") 
For myNr = LBound(myArray, 1) To UBound(myArray, 1)
    myArray(myNr, 1) = "*" & myArray(myNr, 1)
Next myNr

这就是输出： 数组输入

但是我所有的尝试都失败了......

我无法在我的数据透视表上过滤这些内容。

这些只是我尝试过的一些选项：

Sub test2()
Dim myArray() As Variant
Dim myNr As Long
Dim pvItem As PivotItem

Bereich = Range("_Bereich")

myArray = Range("_" & Bereich & "Filter")
For myNr = LBound(myArray, 1) To UBound(myArray, 1)
    myArray(myNr, 1) = "*" & myArray(myNr, 1)
    Debug.Print myArray(myNr, 1)
Next myNr

Worksheets(Bereich).Select
With ActiveSheet.PivotTables("tblMenge" & Bereich).PivotFields("Material")
    .EnableMultiplePageItems = True
    .ClearAllFilters
    For Each pvItem In .PivotItems
        If Not IsError(Application.Match(pvItem.Caption, myArray, 0)) Then
            pvItem.Visible = True
        Else
            pvItem.Visible = False
        End If
    Next pvItem
End With

End Sub

Sub test3()
Dim myArray() As Variant
Dim myNr As Long
Dim pvItem

Bereich = Range("_Bereich")
Worksheets(Bereich).Select
With ActiveSheet.PivotTables("tblMenge" & Bereich).PivotFields("Material")
    .ClearAllFilters
    .EnableMultiplePageItems = True
    For Each pvItem In .PivotItems("All")
        pvItem.Visible = False
    Next
    
    myArray = Range("_" & Bereich & "Filter") 
    
    For myNr = LBound(myArray, 1) To UBound(myArray, 1)
        .PivotItems(myArray(myNr, 1)).Visible = True
    Next myNr
End With

End Sub

Sub test5()
Bereich = Range("_Bereich")

Dim myArray As Variant
myArray = Range("_" & Bereich & "Filter")

Dim pvFld As PivotField, found As Boolean, n As Long, i As Long, j As Long
Set pvFld = ActiveSheet.PivotTables("tblMenge" & Bereich).PivotFields("Material")

With pvFld
    .ClearAllFilters
    For i = 1 To .PivotItems.Count
        found = False
        For j = LBound(myArray, 1) To UBound(myArray, 1)
        myArray(j, 1) = "*" & myArray(j, 1)
            If .PivotItems(i).Name = myArray(j, 1) Then
                found = True
                n = n + 1
                Exit For
            End If
        Next j
        If i = .PivotItems.Count And n = 0 Then
            .ClearAllFilters
            MsgBox "Unable to filter by the list of pivot items", _
                vbExclamation, "No items found"
        ElseIf Not found Then
            .PivotItems(i).Visible = False
        End If
    Next i
    .EnableMultiplePageItems = True
End With

End Sub

Answer 1

• PivotItemName

  中的

  .PivotItems(...)

  必须与商品完全相同。它不支持通配符。

• Like

  是比较两个字符串的运算符。它支持通配符。

微软文档：

喜欢运营商

Sub test3()
    Dim myArray() As Variant
    Dim myNr As Long
    Dim pvItem As PivotItem
    Worksheets(Bereich).Select
    Bereich = Range("_Bereich")
    myArray = Range("_" & Bereich & "Filter").Value
    For myNr = LBound(myArray, 1) To UBound(myArray, 1)
        myArray(myNr, 1) = "*" & myArray(myNr, 1)
    Next myNr
    With ActiveSheet.PivotTables("tblMenge" & Bereich).PivotFields("Material")
        .ClearAllFilters
        .EnableMultiplePageItems = True
        For Each pvItem In .PivotItems
            pvItem.Visible = False
            For myNr = LBound(myArray, 1) To UBound(myArray, 1)
                If pvItem.Name Like myArray(myNr, 1) Then
                    pvItem.Visible = True
                    Exit For
                End If
            Next myNr
        Next
    End With
End Sub