如何使用VBA申请For Loop创建多个PIVOT表

时间:2018-08-07 11:15:34

标签: excel-vba for-loop pivot-table

我想创建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

我是一个初学者,所以无法理解如何申请循环以自动执行此记录的代码?

1 个答案:

答案 0 :(得分:1)

在以下宏中,由于您的示例代码未包含要用于pagefield的所有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