根据列表框中的选定项目在切片器上选择项目

Question

我需要帮助，因为我现在的方法非常慢。 我需要根据我的列表框中选择的项目选择连接到多个枢轴的切片器中的项目。

这是我现在的代码

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Dim oPI As PivotItem
    Dim x As Integer, a As Integer, b As Integer, c As Integer, d As Integer
    Dim exitLoop As Boolean
    Dim selSubRegion() As String
    Dim nonselSubRegion() As String
    ReDim nonselSubRegion(9999)
    ReDim selSubRegion(9999)
    Dim selL1() As String
    Dim nonselL1() As String
    ReDim nonselL1(9999)
    ReDim selL1(9999)


    For x = 0 To UserForm5.ListBox2.ListCount - 1
        If UserForm5.ListBox2.Selected(x) = True Then
           selL1(c) = UserForm5.ListBox2.LIST(x)
           c = c + 1
        Else
            nonselL1(d) = UserForm5.ListBox2.LIST(x)
            d = d + 1
End If
Next x
ReDim Preserve selL1(c)
ReDim Preserve nonselL1(d)
On Error Resume Next
For Each ws In ThisWorkbook.Sheets
    If ws.Name = "FilterSelections" Then
        For Each pt In ws.PivotTables
            pt.ManualUpdate = True
            If pt.Name = "PivotTable1" Then
            If c = 0 Then
            Else
                For x = 0 To UBound(selSubRegion)
                    pt.PivotFields("Recuiter's Manager").PivotItems(selL1(x)).Visible = True

                Next x
                For x = 0 To UBound(nonselSubRegion)
                    pt.PivotFields("Recuiter's Manager").PivotItems(nonselL1(x)).Visible = False
                Next x
            End If
            End If
            pt.ManualUpdate = False

        Next pt
End If
Next ws
On Error GoTo 0
Erase nonselSubRegion
Erase selSubRegion
Erase selL1
Erase nonselL1
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
ActiveSheet.DisplayPageBreaks = True

这是一个非常慢的问题，我需要改进此代码。