如何提高VBA代碼的速度

Question

我一直在嘗試使用VBA幾個月，但我不確定我在編寫速度方面非常高效。

以下代碼是計算股票排名模型中使用的zscores。計算非常簡單，只需計算zscore=zscore1*weight1+zscore2*weight2....zscoreN*zscoreN，其中zscores位於不同的工作表中，並且權重包含在一個數組中。該代碼有效，但有500個股票和103個週期，大約需要30秒才能完成。我一直在尋求建議，以加速我的代碼/使其更好地「正確」，就好的編程實踐而言。

我知道我的代碼是混亂的，但因爲它的工作原理，我只是希望我可以在使用循環，if-sentenses和數組的方式上得到一些一般性建議。

Public factor() As Single 

Sub zscores() 
Dim StartTime As Double, EndTime As Double 
Dim sheetNames() As String 
Dim r As Integer, i As Integer 
Dim antalAktier As Integer, perioder As Integer 
Dim zscore As Single 
StartTime = Timer 

Worksheets("ZScores").Range("B2:AAA1000").ClearContents 

'perioder and antalAktier is just variables to determine number of stocks and periods 
perioder = Application.WorksheetFunction.CountA(Worksheets("returns").Range("A2:A1500")) 
antalAktier = Application.WorksheetFunction.CountA(Worksheets("returns").Range("B1:AAA1")) 

'Makes an array of sheetnames 
r = 1 
i = 0 
ReDim sheetNames(0) 
Do Until Worksheets("BloomdataFLDS").Cells(r, 1).Value = "" 
    sheetNames(i) = Worksheets("BloomdataFLDS").Cells(r, 1).Value 
    i = i + 1 
    ReDim Preserve sheetNames(i) 
    r = r + 1 
Loop 

'factor() is an array of values from textboxes in a userform 
'Code uses the sheetnames array to jump between sheets and making a weighted average of the cell values and factor array values 
k = 2 
For k = 2 To antalAktier + 1 
    r = 2 
    For r = 2 To perioder + 1 
     zscore = 0 
     For i = 0 To (UBound(factor) - 18) 
      zscore = zscore + (factor(i) * Worksheets(sheetNames(i)).Cells(r, k).Value) 
     Next i 
     'truncates the value to be max/min +/- 3 
     If Worksheets("binær").Cells(k, r).Value = 1 And Worksheets("returns").Cells(r, k).Value <> "#N/A N/A" Then 
      If zscore < 3 And zscore > -3 Then 
       Worksheets("ZScores").Cells(r, k).Value = zscore 
      ElseIf zscore < -3 Then 
       Worksheets("ZScores").Cells(r, k).Value = -3 
      ElseIf zscore > 3 Then 
       Worksheets("ZScores").Cells(r, k).Value = 3 
      End If 
     Else: 
      Worksheets("ZScores").Cells(r, k).Value = "" 
     End If 
    Next r 
Next k 
EndTime = Timer 
MsgBox "Execution time in seconds: " + Format$(EndTime - StartTime) 
End Sub 

Answer 1

提高性能的最常見方法是禁用視覺反饋。在結束

Excel.Application.ScreenUpdating = False 
Excel.Application.Calculation = Excel.xlCalculationManual 
Excel.Application.EnableEvents = False 

這：您可以只添加這在一開始

Excel.Application.ScreenUpdating = True 
Excel.Application.Calculation = Excel.xlAutomatic 
Excel.Application.EnableEvents = True 

還要注意的是ReDim Preserve sheetNames(i)需要花費很多時間，太。您可以使用集合而不是數組。

Answer 2

一般以加快您的代碼添加

Application.ScreenUpdating = False 

到啓動代碼&

Application.ScreenUpdating = True 

的進行到底。

我想，使用VBAs計數功能將至少比Excel的CountA略好一點的性能。 所以不是

perioder = Application.WorksheetFunction.CountA(Worksheets("returns").Range("A2:A1500")) 

你可能會使用

perioder = Worksheets("returns").Range(Range("A2"),Range("A2").end(xlDown)).Count 

（我假設不存在應考慮你在小區空Do循環結束缺口）會更好。

多ReDims很可能放慢你失望，所以我想從你的Do循環&變化刪除

ReDim Preserve sheetNames(i) 

ReDim sheetNames(0) 

到

ReDim sheetNames(perioder) 

而且

0作爲

With Worksheets("ZScores").Cells(r, k) 
    If zscore < 3 And zscore > -3 Then 
     .Value = zscore 
    ElseIf zscore < -3 Then 
     .Value = -3 
    ElseIf zscore > 3 Then 
     .Value = 3 
    End If 
End With 

希望它可以幫助

會更有效。

Answer 3

我不知道多少時間可以節省，但使用ReDim和ReDim Preserve會浪費大量的內存（我不知道你做了多少次迭代，所以這會影響使用ReDim Preserve的效率） 。

每次執行ReDim Preserve時，該數組都將被採集並複製，從而使用調整後的尺寸創建自己的新實例。你可以不使用使用ReDim保留執行的代碼段，象下面這樣：

Dim lrow As Long 
Dim sheetNames() As Variant 

lrow = Cells(Rows.Count, 1).End(xlUp).Row 
sheetNames = Sheets("BloomdataFLDS").Range(Cells(1, 1), Cells(lrow, 1)).Value 

除非有就是爲什麼你不希望有一個變種二維數組任何理由特別？從工作表分配數組時，即使只有1維數據，也會生成2d數組。當你遍歷數組時，你只需要指定第二維總是'1'。

在我寫這篇文章時，@ jbmb2000已經提到了第二個循環的效率，所以我不會繼續。希望這有助於。