数据透视表到PDF循环？

所以我想出了如何获得一个数据透视表保存到指定的文件夹为.PDF，但我很好奇，如果有人知道是否有一种方法来循环我的代码，而不是所有分开？

我的代码工作，但只是好奇，如果有一种方法来凝结它？

Sub Test1234() '''Sales Team1''' Sheets("Worksheet1").Activate '''adjust the range if the Pivot Table moves''' Range("C3").Select ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").ClearAllFilters '''adjust the vertical name in the quotes below''' ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").CurrentPage = _ "Sales Team1" Sheets("Worksheet1").Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Desktop" & Format(Date, " dd.mm.yyyy") '''Sales Team2''' Sheets("Worksheet1").Activate '''adjust the range if the Pivot Table moves''' Range("C3").Select ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").ClearAllFilters '''adjust the vertical name in the quotes below''' ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").CurrentPage = _ "Sales Team2" Sheets("Worksheet1").Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Desktop" & Format(Date, " dd.mm.yyyy") '''Sales Team3''' Sheets("Worksheet1").Activate '''adjust the range if the Pivot Table moves''' Range("C3").Select ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").ClearAllFilters '''adjust the vertical name in the quotes below''' ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").CurrentPage = _ "Sales Team3" Sheets("Worksheet1").Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Desktop" & Format(Date, " dd.mm.yyyy") End Sub 

Answer 1

尝试下面的代码，没有必要一直使用Activate和Select （这也会减慢代码的运行时间）。

阅读这里为什么你应该远离Select / Activate / Selection / ActiveSheet等

码

 Option Explicit Sub Test1234() Dim PvtTbl As PivotTable Dim PvtFld As PivotField Dim ws As Worksheet Dim i As Long ' set the worksheet where "PivotTable2" Set ws = Worksheets("Worksheet1") ' set the Pivot Table Set PvtTbl = ws.PivotTables("PivotTable2") ' set the Pivot Field "Vertical" Set PvtFld = PvtTbl.PivotFields("Vertical") With PvtFld For i = 1 To 3 .ClearAllFilters 'adjust the vertical name in the quotes below .CurrentPage = "Sales Team" & i ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Desktop" & Format(Date, " dd.mm.yyyy") Next i End With End Sub 

Answer 2

你可以简单地做一个for循环。

 Sub test_m() Dim wsh As Worksheet Dim i As Integer Dim team As String Set wsh = Sheets("Worksheet1") For i = 1 To 3 team = "Sales Team" & i wsh.Activate '''adjust the range if the Pivot Table moves''' Range("C3").Select wsh.PivotTables("PivotTable2").PivotFields("Vertical").ClearAllFilters '''adjust the vertical name in the quotes below''' ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").CurrentPage = team Sheets("Worksheet1").Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=team & _ Format(Date, " dd.mm.yyyy") Next i End Sub