excel - 减少重复代码以避免 "Procedure Too Large"错误

Question

我目前有一些 VBA 代码基本上替换了数据透视表中的过滤器字段，但是由于当前的 excel 电子表格有数百个数据透视表，我已经到了 VBA 不能与太大的过程一起使用的地步。

问题是我不知道如何减少重复 - 任何帮助都将不胜感激。

下面的代码:

 Private Sub Worksheet_Change(ByVal Target As Range)
        If Intersect(Target, Range("P6:P7")) Is Nothing Then Exit Sub

        Dim pt As PivotTable
        Dim Field As PivotField
        Dim NewCat As String

        Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable8")
        Set Field = pt.PivotFields("Company Code")
        NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value

        With pt
             Field.ClearAllFilters
             Field.CurrentPage = NewCat


        End With

        Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable6")
        Set Field = pt.PivotFields("Company Code")
        NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value

        With pt
             Field.ClearAllFilters
             Field.CurrentPage = NewCat


        End With

        Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable20")
        Set Field = pt.PivotFields("Company Code")
        NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value

        With pt
             Field.ClearAllFilters
             Field.CurrentPage = NewCat


        End With

        Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable7")
        Set Field = pt.PivotFields("Company Code")
        NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value

        With pt
             Field.ClearAllFilters
             Field.CurrentPage = NewCat


     'Keeps on repeating for about 200 more PivotTables in Various Sheets

 End With

 End Sub

Answer 1

如果要更改该工作表上的所有数据透视表:

Private Sub Worksheet_Change(ByVal Target As Range)

        If Intersect(Target, Range("P6:P7")) Is Nothing Then Exit Sub

        Dim pt As PivotTable, NewCat As String, s

        NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value

        For Each s In Array("Pivot Booking", "Pivot Transaction", _
                                             "Pivot Level Segment")

            For Each pt In Worksheets(s).PivotTables
                With pt.PivotFields("Company Code")
                    .ClearAllFilters
                    .CurrentPage = NewCat
                End With
            Next pt

        Next s

End Sub