我想创建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
我是一个初学者,所以无法理解如何申请循环以自动执行此记录的代码?
答案 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