如何应用 For 循环使用 VBA 创建多个 PIVOT 表

Question

我要创建14个数据透视表，我已经录制了一个宏，我的宏代码如下。如果我想申请循环创建14个数据透视表，该怎么做？

我是一个初学者，所以无法理解如何申请循环来自动化这段记录的代码？

我的宏如下：

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Current Fleet Comparison!R1C1:R1048576C41", Version:=xlPivotTableVersion14). _
        CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
        , DefaultVersion:=xlPivotTableVersion14
    Sheets("Sheet1").Select
    Cells(3, 1).Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("AircraftType")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("AircraftType"), "Count of AircraftType", xlCount
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("OperatorArea")
        .Orientation = xlColumnField
        .Position = 1
    End With
    Range("A1:F5").Select
    Selection.Copy
    Range("A8").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable2").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable2").PivotFields("AircraftType").CurrentPage _
        = "A318"
    Range("A15").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable3").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable3").PivotFields("AircraftType").CurrentPage _
        = "A319"
    Range("A22").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable4").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable4").PivotFields("AircraftType").CurrentPage _
        = "A320"
    ActiveWindow.SmallScroll Down:=15
    Range("A29").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable5").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable5").PivotFields("AircraftType").CurrentPage _
        = "A321"
    Range("A36").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable6").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable6").PivotFields("AircraftType").CurrentPage _
        = "ATR 42"
    ActiveWindow.SmallScroll Down:=3
    Range("A43").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable7").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable7").PivotFields("AircraftType").CurrentPage _
        = "ATR 72"
    ActiveWindow.SmallScroll Down:=9
    Range("A50").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable8").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable8").PivotFields("AircraftType").CurrentPage _
        = "CRJ100 Regional Jet"
    ActiveWindow.SmallScroll Down:=3
    Range("A57").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable9").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable9").PivotFields("AircraftType").CurrentPage _
        = "CRJ200 Regional Jet"
    ActiveWindow.SmallScroll Down:=12
    Range("A65").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable10").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable10").PivotFields("AircraftType"). _
        CurrentPage = "Q100"
    Range("A72").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable11").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable11").PivotFields("AircraftType"). _
        CurrentPage = "Q200"
    ActiveWindow.SmallScroll Down:=9
    Range("A79").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable12").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable12").PivotFields("AircraftType"). _
        CurrentPage = "Q300"
    ActiveWindow.SmallScroll Down:=9
    Range("A86").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable13").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable13").PivotFields("AircraftType"). _
        CurrentPage = "Q400"
    ActiveWindow.SmallScroll Down:=9
    Range("A94").Select
    ActiveSheet.Paste
    ActiveSheet.PivotTables("PivotTable14").PivotFields("AircraftType"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable14").PivotFields("AircraftType"). _
        CurrentPage = "Q400 NextGen"
End Sub

我是一个初学者，所以无法理解如何申请循环来自动化这段记录的代码？

Answer 1

在以下宏中，由于您的示例代码未包含用于页面字段的所有 14 个页面，因此您需要在运行宏之前完成分配给 varPages 的列表...

'Force the explicit declaration of variables
Option Explicit

Sub CreatePivotTables()

    'Declare the variables
    Dim varPages As Variant
    Dim objPivotCache As PivotCache
    Dim objPivotTable As PivotTable
    Dim wksSource As Worksheet
    Dim rngSource As Range
    Dim CurrRow As Long
    Dim i As Long

    'Turn off screen updating to speed up macro
    Application.ScreenUpdating = False

    'Assign the source worksheet for the pivottables to wksSource
    Set wksSource = Worksheets("Current Fleet Comparison")

    'Assign the source range for the pivottables to rngSource
    Set rngSource = wksSource.Range("A1").CurrentRegion

    'Create the pivotcache for the pivottables
    Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
        SourceType:=xlDatabase, _
        SourceData:=rngSource)

    'Add new worksheet for the pivottables
    Sheets.Add

    'Assign the list of pages for the pagefield to varPages (add the remaining pages)
    varPages = Array("A318", "A319", "A320", . . .)

    CurrRow = 3
    For i = 1 To 14
        'Create the pivottable
        Set objPivotTable = ActiveSheet.PivotTables.Add( _
            PivotCache:=objPivotCache, _
            TableDestination:=Cells(CurrRow, "A"), _
            TableName:="PivotTable" & i)
        'Add the fields for the pivottable
        With objPivotTable
            .AddDataField .PivotFields("AircraftType"), "Count of AircraftType", xlCount
            .PivotFields("OperatorArea").Orientation = xlColumnField
            With .PivotFields("AircraftType")
                .Orientation = xlPageField
                .CurrentPage = varPages(i - 1)
            End With
            With .TableRange2
                CurrRow = .Offset(.Rows.Count + 4).Row
            End With
        End With
    Next i

    'Show the pivottable field list
    ActiveWorkbook.ShowPivotTableFieldList = True

    'Turn screen updating back on
    Application.ScreenUpdating = True

End Sub