VBA代码运行缓慢

Question

我有一个相当大的工作簿。有超过18个数据透视表基于表单中的选择进行更新。我的老板要我弄清楚为什么它运行缓慢并修复它。我尝试过，不知道该怎么做。该文件是大到附加的方式。为了附加它..我必须删除超过一半而且这会破坏目的。

有人可以查看代码并查看其中是否有可以重写的内容以使其运行得更快。

' Global and Public Variables
Dim i As Integer
Dim FilterDistributors() As String

' Button that kicks the code off to run
Private Sub btnOK_Click()

Application.ScreenUpdating = False

' Declare variables:
Dim rng As Range
Dim index As Integer
Dim totalLocations As Integer
totalLocations = 0

' Check to see if at least one distributor is selected:
If ListBox2.ListCount = 0 Then
    'Message to be returned if user did not select an item
    MsgBox "Please select at least one distributor!", vbCritical, "Error"

Else

    ' Filter out the pivot table based on the selections.

    ' 1) Find out the size remaining in ListBox1, and assign that to the size of the array.
    ReDim FilterDistributors(ListBox1.ListCount)

    ' 2) Fill up the values in the array with the ones remaining in the List Box1.
    For index = 0 To ListBox1.ListCount - 1

        FilterDistributors(index) = ListBox1.List(index)

    Next

    ' 3) Filter out the pivot table on PGbDPivot to only the values selected:
    FilterChartOnDistributors ("Chart 2")
    FilterChartOnDistributors ("Chart 3")
    FilterChartOnDistributors ("Chart 4")
    FilterChartOnDistributors ("Chart 5")
    FilterChartOnDistributors ("Chart 6")
    FilterChartOnDistributors ("Chart 7")
    FilterChartOnDistributors ("Chart 8")
    FilterChartOnDistributors ("Chart 9")
    FilterChartOnDistributors ("Chart 10")
    FilterChartOnDistributors ("Chart 11")
    FilterChartOnDistributors ("Chart 12")
    FilterChartOnDistributors ("Chart 13")
    FilterChartOnDistributors ("Chart 14")
    FilterChartOnDistributors ("Chart 15")
    FilterChartOnDistributors ("Chart 16")
    FilterChartOnDistributors ("Chart 17")
    FilterChartOnDistributors ("Chart 20")
    FilterChartOnDistributors ("Chart 40")
    FilterChartOnDistributors ("Chart 41")

End If

' Go back to main worksheet
wsProductGroupByDistributor.Activate

Unload Distributor

End Sub
Sub FilterChartOnDistributors(NameOfChart As String)

Dim index As Integer

 ' First make sure all of the current filters are reset:
wsPGbDPivot.ChartObjects(NameOfChart).Activate
ActiveChart.PivotLayout.PivotTable.PivotFields("DISTRIBUTOR").ClearAllFilters

' Then, go through the distributors not selected and make them not visible (or filtered out):
For index = 0 To UBound(FilterDistributors) - 1

    ActiveChart.PivotLayout.PivotTable.PivotFields("DISTRIBUTOR").PivotItems(FilterDistributors(index)).Visible = False

Next

End Sub

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
     For i = 0 To ListBox1.ListCount - 1
         ListBox1.Selected(i) = True
     Next i
End If

If CheckBox1.Value = False Then
     For i = 0 To ListBox1.ListCount - 1
         ListBox1.Selected(i) = False
     Next i
End If

End Sub

Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
     For i = 0 To ListBox2.ListCount - 1
         ListBox2.Selected(i) = True
     Next i
End If

If CheckBox2.Value = False Then
     For i = 0 To ListBox2.ListCount - 1
         ListBox2.Selected(i) = False
     Next i
End If

End Sub


Private Sub CommandButton1_Click()

For i = 0 To ListBox1.ListCount - 1
     If ListBox1.Selected(i) = True Then ListBox2.AddItem ListBox1.List(i)
Next i

For i = Me.ListBox1.ListCount - 1 To 0 Step -1
    If ListBox1.Selected(i) = True Then
    Me.ListBox1.RemoveItem i
    End If
Next i

End Sub


Private Sub CommandButton2_Click()

For i = 0 To ListBox2.ListCount - 1
     If ListBox2.Selected(i) = True Then ListBox1.AddItem ListBox2.List(i)
Next i

For i = ListBox2.ListCount - 1 To 0 Step -1
    If ListBox2.Selected(i) = True Then
    ListBox2.RemoveItem i
    End If
Next i

End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub OptionButton1_Click()
ListBox1.MultiSelect = 0
 ListBox2.MultiSelect = 0

End Sub

Private Sub OptionButton2_Click()
ListBox1.MultiSelect = 1
 ListBox2.MultiSelect = 1

End Sub

Private Sub OptionButton3_Click()
ListBox1.MultiSelect = 2
 ListBox2.MultiSelect = 2

End Sub

Private Sub UserForm_Initialize()
    Dim myList As Collection
    Dim myRange As Range
    Dim ws As Worksheet
    Dim myVal As Variant

    Set ws = ThisWorkbook.Sheets("Locations")
    Set myRange = ws.Range("k2", ws.Range("k2").End(xlDown))
    Set myList = New Collection

    On Error Resume Next
    For Each myCell In myRange.Cells
    myList.Add myCell.Value, CStr(myCell.Value)
    Next myCell
    On Error GoTo 0

    For Each myVal In myList
    Me.ListBox1.AddItem myVal
    Next myVal


OptionButton2.Value = True

End Sub