如何加快与切片机这个VBA代码？

我有一个电子表格有七个表格（tbl_1，tbl_2 … tbl_7），每个表格由自己的切片机控制。 每个切片机有六个button（10,20,30,40,50,60）参考团队代码。 我使用下面的代码在每个切片机上select一个团队，然后为每个团队/切片机设置创build一个PDF。 截至目前，代码需要从5-7分钟的任何地方运行。 任何帮助深表感谢。

Sub SlicerTeam() Dim wb As Workbook Dim sc As SlicerCache Dim si As SlicerItem On Error GoTo errHandler Application.ScreenUpdating = False Application.EnableEvents = False Set wb = ThisWorkbook For x = 1 To 6 For i = 1 To 7 Set sc = wb.SlicerCaches("tbl_" & i) sc.ClearAllFilters For Each si In sc.VisibleSlicerItems Set si = sc.SlicerItems(si.Name) If Not si Is Nothing Then If si.Name = x * 10 Then si.Selected = True Else si.Selected = False End If Else si.Selected = False End If Next si Next i Call PDFCreate Next x exitHandler: Application.ScreenUpdating = True Application.EnableEvents = True Exit Sub errHandler: MsgBox ("Error in updating slicer filters.") Resume exitHandler End Sub 

Answer 1

假设这些切片机正在切分数据透视表，请尝试下面的代码。 这可能有助于加快速度，取决于数据透视表的大小。

 Sub SlicerTeam() Dim wb As Workbook Dim sc As SlicerCache Dim si As SlicerItem dim pt as PivotTable On Error GoTo errHandler Application.ScreenUpdating = False Application.EnableEvents = False Set wb = ThisWorkbook For Each pt in wb.PivotTables pt.ManualUpdate = True Next For x = 1 To 6 For i = 1 To 7 Set sc = wb.SlicerCaches("tbl_" & i) sc.ClearAllFilters For Each si In sc.VisibleSlicerItems Set si = sc.SlicerItems(si.Name) If Not si Is Nothing Then If si.Name = x * 10 Then si.Selected = True Else si.Selected = False End If Else si.Selected = False End If Next si Next i For Each pt in wb.PivotTables pt.ManualUpdate = True Next Call PDFCreate Next x exitHandler: Application.ScreenUpdating = True Application.EnableEvents = True Exit Sub errHandler: MsgBox ("Error in updating slicer filters.") Resume exitHandler End Sub