VBA - 循环数据透视表过滤提取

Question

我有以下代码将过滤器应用于数据透视表，然后从数据透视表复制特定数据并删除过滤器。问题是，这一段代码使用了 22 次，子是 waaaay太长。

这是我只有一个块的代码：

    Option Explicit

        Sub FilterPivotTable()

        Dim rLastCell As Range
        Dim PvtTbl As PivotTable
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim LastRow1 As Long
        Set ws1 = ActiveWorkbook.Sheets("PivotTable")
        Set ws2 = ActiveWorkbook.Sheets("Summary")
        Dim rowCount As Long

            LastRow1 = ws1.Cells(Rows.Count, 1)

            'Microsoft Windows
            Application.ScreenUpdating = False

            ws1.PivotTables("P1").ManualUpdate = True

            ws1.PivotTables("P1").PivotFields(" Vulnerability Name").ClearAllFilters

    '---------------Block Starts Here---------------

            ws1.PivotTables("P1").PivotFields(" Vulnerability Name").PivotFilters. _
            Add Type:=xlCaptionContains, Value1:="Microsoft Windows"

            ws1.PivotTables("P1").ManualUpdate = False
            Application.ScreenUpdating = True

            With ws1.PivotTables(1).TableRange1
                Set rLastCell = .Cells(.Rows.Count, .Columns.Count)
                Set PvtTbl = Worksheets("PivotTable").PivotTables("P1")
                rLastCell.Copy

                With ws2

                    .Cells(LastRow1 + 2, 3).PasteSpecial xlPasteValues
                    .Range("$B$2").Value = "Microsoft Windows"

                    rowCount = PvtTbl.DataBodyRange.Rows.Count
                    .Range("$D$2") = rowCount - 1

                End With

            End With

            ws1.PivotTables("P1").PivotFields(" Vulnerability Name").ClearAllFilters

'---------------Block Ends Here---------------

        End Sub

此代码块在整个子程序中重复了 22 次，每次仅更改漏洞名称，即将 'Microsoft Windows' 更改为 'Adobe'，然后更改将数据复制到汇总表的位置的单元格引用。

我希望有一个循环访问漏洞名称的代码块，而不是让 22 个不同的代码块执行相同的功能。

这是透视表结构的样子：

过滤器在行块下完成，并在漏洞名称上完成

Answer 1

恐怕这有点像在黑暗中冒险

Option Explicit

Sub FilterPivotTable()

    Dim rLastCell As Range
    Dim PvtTbl As PivotTable
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = ActiveWorkbook.Sheets("PivotTable")
    Set ws2 = ActiveWorkbook.Sheets("Summary")

    Dim rowCount As Long
    Dim LastRow1 As Long
    Dim pvtField As PivotField

    Set PvtTbl = ws1.PivotTables("P1")

    Application.ScreenUpdating = False

    Set pvtField = PvtTbl.PivotFields(" Vulnerability Name") 'extend etc as required

    Dim myArr()
    myArr = Array("Microsoft Windows", "Adobe Reader", "Other")

    'PvtTbl.ManualUpdate = False

    Dim i As Long

    For i = LBound(myArr) To UBound(myArr)

        pvtField.ClearAllFilters
        pvtField.PivotFilters. _
        Add Type:=xlCaptionContains, Value1:=myArr(i)

        With ws1.PivotTables(1).TableRange1
            Set rLastCell = .Cells(.Rows.count, .Columns.count) 'grand total?
        End With

        With ws2
            LastRow1 = ws2.Cells(ws2.Rows.count, 3).End(xlUp).row
            rLastCell.Copy
            .Cells(LastRow1 + 1, 3).PasteSpecial xlPasteValues
            .Cells(LastRow1 + 1, 2).Value = myArr(i)
            rowCount = PvtTbl.DataBodyRange.Rows.count
            .Cells(LastRow1 + 1, 4) = rowCount - 1
        End With

    Next i

    Application.ScreenUpdating = True
    'PvtTbl.ManualUpdate = False
End Sub