Excel vba：为每个对象类设置一个长变量会大大增加执行时间

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 seconds运行之后，这行代码被注释掉了。但是，如果该行未被注释掉并执行，则第二个循环需要运行2 minute 35 seconds。

这是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