VBA使用命名区域通配符数组过滤Pivot Table失败求助

初始情况 #

需对数据透视表的「Material」字段按多个特定关键词进行模糊过滤，数据格式示例：

• 7.06610.14.0 EDR-E -> 需匹配的关键词为EDR-E
• 7.03083.11.0 EAM
• 7.05569.18.0 REGELKLAPPE
• 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

尝试过的过滤代码 #

代码1：test2 #

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

代码2：test3 #

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

代码3：test5 #

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

内容的提问来源于stack exchange，提问作者Sally BRB