Excel VBA中：设置一个长变量为每个对象类显着地增加执行时间

Z时代
2024-01-10
分类：问答

我有一个主子，使得使用一个Client类：与100 000Clients创建一个数组并循环阵列之上100次，每次设置不同的随机数到每个Client。Excel VBA中：设置一个长变量为每个对象类显着地增加执行时间

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 startMsgBox需要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每个客户端里面。为什么它会将执行时间增加九倍？

回答：

您已将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