vba - Excel vba : setting a long variable for each object class dramatically increases execution time

Question

我有一个使用 Client 类的主子程序:使用 100 000 Clients 创建一个数组，并在该数组上循环 100 次，每次为每个 Client 设置不同的随机数。

Sub start()
    Application.ScreenUpdating = False

    Dim j As Long

    Dim clientsColl() As Client
    ReDim clientsColl(1 To 100000) As Client

    For j = 1 To 100000
        Set clientsColl(j) = New Client

        clientsColl(j).setClientName = "Client_" & j
    Next

    Dim clientCopy As Variant

    MsgBox ("simulations start")
    Dim i As Long
    For i = 1 To 100
        For Each clientCopy In clientsColl
            clientCopy.setSimulationCount = 100
            clientCopy.generateRandom
        Next
    Next

    Application.StatusBar = False
    Application.ScreenUpdating = True

    MsgBox ("done")
End Sub

但是，此代码的运行时间会有所不同，具体取决于 clientCopy.setSimulationCount = 100 行是否被注释掉。如果将此行注释掉，则 simulations start 之后的代码 MsgBox 需要 16 秒 才能运行。但是，如果该行未注释掉并执行，则第二个循环需要 2 分 35 秒 才能运行。

这是 Client 类的内部，使用的 Let 属性:

Private simulationCount As Long

Public Property Let setSimulationCount(value As Double)
    simulationCount = value
End Property

Private randomNumber As Double

Public Sub generateRandom()
    randomNumber = Rnd()
End Sub

所以它只是将数字100放入每个客户端中。为什么它会使执行时间增加九倍？

Answer 1

您已将 clientCopy 定义为 Variant，必须在每次方法调用的运行时解析它。请更改为 Client 类型并重新运行计时。

好的，我已经重新阅读了问题和评论，以加快循环速度，因此进行更改

Option Explicit

Sub start()
    Application.ScreenUpdating = False

    Dim j As Long

    Dim clientsColl() As Client
    ReDim clientsColl(1 To 100000) As Client

    For j = 1 To 100000
        Set clientsColl(j) = New Client

        clientsColl(j).setClientName = "Client_" & j
    Next

    'Dim clientCopy As Variant
    Dim clientCopy As Client

    MsgBox ("simulations start")
    Dim i As Long
    For i = 1 To 100
        Dim lClientLoop As Long
        For lClientLoop = LBound(clientsColl) To UBound(clientsColl)
        'For Each clientCopy In clientsColl
            Set clientCopy = clientsColl(lClientLoop)
            clientCopy.setSimulationCount = 100
            clientCopy.generateRandom
        Next
    Next

    Application.StatusBar = False
    Application.ScreenUpdating = True

    MsgBox ("done")
End Sub