Question

我已经尝试使用VBA几个月了，但是我不确定我在速度方面是否非常有效。

以下代码是对股票排名模型中使用的zscores的计算。计算非常简单，只计算zscores，其中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位于不同的工作表中，权重包含在数组中。该代码有效，但有500个库存和103个周期需要大约30秒才能完成。我正在寻找建议，以加快我的代码/使其更好“正确”，就像良好的编程实践。

我知道我的代码很麻烦，但是因为它的工作原理我希望我可以在使用循环，if-sentenses和数组的方式上得到一些一般的建议。

{{1}}

Answer 1

一般来说，加快代码添加

Application.ScreenUpdating = False

代码的开头＆amp;

Application.ScreenUpdating = True

到最后。

我猜想使用VBAs Count函数至少会比Excel的CountA具有更好的性能。而不是

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

你最好不要使用

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

（我假设当单元格为空时，考虑到你的Do Loop结束应该没有间隙。）

多个ReDims可能会减慢你的速度，所以我会删除

ReDim Preserve sheetNames(i)

来自你的Do Loop＆amp;变化

ReDim sheetNames(0)

到

ReDim sheetNames(perioder)

另外

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

会更有效率

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 2

提高性能的最常见方法是禁用视觉反馈。您可以在开头添加：

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 3

我不确定它会节省多少时间，但使用Promusage和ReDim可能会浪费大量内存（我不确定你制作了多少次迭代，这会影响使用ReDim Preserve）的效率。

每次执行ReDim Preserve时，都会获取并复制数组，并使用调整大小的维度创建自身的新实例。您可以在不使用ReDim Preserve的情况下执行代码部分，如下所示：

ReDim Preserve

除非有任何理由特别为什么你不希望拥有变体2d阵列？从工作表中分配数组时，即使您只有1维数据，也会生成2d数组。当您遍历数组时，您只需指定第二维始终是＆＃39; 1＆＃39;。

正如我写的那样@ jbmb2000已经提到了第二循环的效率，所以我不会继续。希望这会有所帮助。

如何提高VBA代码的速度

3 个答案: