如何使用切片器加速此VBA代碼？

Question

我有一個電子表格，包含七個表格（tbl_1，tbl_2 ... tbl_7），每個表格都由它自己的切片器控制。每個切片機有6個按鈕（10,20,30,40,50,60）參考團隊代碼。我使用下面的代碼在每個切片器上選擇一個團隊，然後爲每個團隊/切片器設置創建一個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