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

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

1 个答案: