循环通过工作簿执行相同的过程

我试图通过一个Excel工作簿循环来创build每张工作表上相同的数据透视表,而每张工作表包含不同的数据在同一列。 数据透视表工作,但循环完成第一个工作表后停止。

有没有人有build议让循环遍历所有的工作表?

Sub PivotTableLoop() Dim FinalRow As Long Dim DataSheet As String Dim PvtCache As PivotCache Dim PvtTbl As PivotTable Dim DataRng As Range Dim TableDest As Range Dim ws As Worksheet Dim wb As Workbook Set wb = ActiveWorkbook FinalRow = Cells(Rows.Count, 1).End(xlUp).Row DataSheet = ActiveSheet.Name 'Beginning of Loop For Each ws In ActiveWorkbook.Worksheets 'set data range for Pivot Table Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 8)) ' conversion of R1C1:R & FinalRow & C8 'set range for Pivot table placement Set TableDest = Sheets(DataSheet).Cells(1, 9) ' conversion of R1C9 Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataRng) 'this line in case the Pivot table doesn't exit >> first time running this Macro On Error Resume Next Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables("PivotTable4") ' check if "PivotTable4" Pivot Table already created (in past runs of this Macro) On Error GoTo 0 If PvtTbl Is Nothing Then ' "PivotTable4" doesn't exist >> create it 'create a new Pivot Table in "PivotTable4" sheet Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables.Add(PivotCache:=PvtCache, TableDestination:=TableDest, TableName:="PivotTable4") With PvtTbl.PivotFields("Document Type") .Orientation = xlRowField .Position = 1 End With With PvtTbl.PivotFields("Accounting Event") .Orientation = xlRowField .Position = 2 End With With PvtTbl.PivotFields("Document Number") .Orientation = xlRowField .Position = 3 End With PvtTbl.AddDataField ActiveSheet.PivotTables( _ "PivotTable4").PivotFields("Amount"), "Sum of Amount", xlSum ActiveCell.Offset(1, 0).Range("A1").Select PvtTbl.PivotFields("Document Type").ShowDetail _ = False ActiveCell.Offset(-1, 0).Range("A1").Select PvtTbl.CompactLayoutRowHeader = _ "JIFMS Document Types" ActiveCell.Offset(2, 1).Range("A1").Select PvtTbl.PivotSelect "", xlDataAndLabel, True PvtTbl.DataPivotField.PivotItems( _ "Sum of Amount").Caption = "JIFMS Sum of Amounts" ActiveCell.Offset(5, 0).Range("A1").Select Else 'just refresh the Pivot cache with the updated Range PvtTbl.ChangePivotCache PvtCache PvtTbl.RefreshTableenter code here End If Next ws End Sub 

首先,学会缩进你的代码 。 当所有代码块的内容在列1中时读取代码使得头部旋转。 难以阅读的代码是难以debugging的代码。

获取VBE加载项。 如果您使用的是32位Office,则可以使用智能压缩器为您完成此操作。 如果你在64位的办公室,你可以使用最新的MZ工具($$$我认为),或免费和开源的Rubberduck (其中, 免责声明 ,我大量参与) – v2.x(还是testing版)包含了大多数智能压痕器的function。

也摆脱了这样的烦人和无用的线延续:

 PvtTbl.PivotFields("Document Type").ShowDetail _ = False 

/咆哮


在第一次迭代之后,您不会将PvtTbl设置为Nothing ,因此整个If...End If块将在引用被分配一次后运行,大概是在第一次迭代中。

通过将循环的主体抽取到自己的过程中(从而将PvtTbl基本上限定在循环体中),可以消除问题并提高代码的可读性。 这个操作被称为“提取方法”重构。

你也在迭代活动工作簿中的所有工作表,但是你并没有在循环体内的任何地方使用ws ,所以一切工作在活动工作表上……这可能不是你想要的。