VBA 崩溃大约 700 次迭代 - 当我尝试将此 VBA 循环运行到 1000 秒（650 次是安全的）迭代时，Excel 不断崩溃。有什么想法吗？

VBA Crashing Around 700 Iterations - Excel keeps crashing when I try to run this VBA loop out to 1000s, (650 is safe) iterations. Any thoughts?

提问人：Andrew Jessberger 提问时间：11/2/2023 最后编辑：tallerAndrew Jessberger 更新时间：11/2/2023 访问量：32

问：

  Sub LottoSearch()
   Dim stopRunUp As Integer
   stopRunUp = 0
    For i = 2 To 1000

     lottoNum = Cells(i, 3).Value

      If lottoNum = 3957481 Then
        Cells(2, 6).Value = Cells(i, 1).Value
        Cells(2, 7).Value = Cells(i, 2).Value
        Cells(2, 8).Value = lottoNum
        MsgBox ("Congratulations " + Str(Cells(2, 6).Value) + " " + Str(Cells(2, 7).Value))
      End If

      If lottoNum = 5865187 Then
       Cells(3, 6).Value = Cells(i, 1).Value
       Cells(3, 7).Value = Cells(i, 2).Value
       Cells(3, 8).Value = lottoNum
      End If

     If lottoNum = 2817729 Then
       Cells(4, 6).Value = Cells(i, 1).Value
       Cells(4, 7).Value = Cells(i, 2).Value
       Cells(4, 8).Value = lottoNum
     End If

     If lottoNum = 2275339 And stopRunUp = 0 Then
       Cells(5, 6).Value = Cells(i, 1).Value
       Cells(5, 7).Value = Cells(i, 2).Value
       Cells(5, 8).Value = lottoNum
       stopRunUp = 1
     End If

     If lottoNum = 5868182 And stopRunUp = 0 Then
       Cells(5, 6).Value = Cells(i, 1).Value
       Cells(5, 7).Value = Cells(i, 2).Value
       Cells(5, 8).Value = lottoNum
       stopRunUp = 1
     End If

     If lottoNum = 1841402 And stopRunUp = 0 Then
       Cells(5, 6).Value = Cells(i, 1).Value
       Cells(5, 7).Value = Cells(i, 2).Value
       Cells(5, 8).Value = lottoNum
       stopRunUp = 1
     End If

   Next i

 End Sub

我已经仔细检查了我是否有 Excel （Microsoft 365）的更新版本。

确保有足够的内存空间和 CPU。

尝试过在Excel业务和家庭中，看看是否有任何不同，没有运气。

只要我的 for 循环限制为 650 或更低，代码就会起作用。

还有其他人遇到过这个问题吗？

Excel VBA for 循环崩溃

答：

0赞 taller 11/2/2023 #1

读取和写入单元会消耗 PC 资源并占用时间。将数据加载到数组中并在内存中处理数据可提高效率。
使用比使用多个语句更好。ElseIfIf

Option Explicit
Sub LottoSearch()
    Dim stopRunUp As Integer
    Dim lastRow As Long, lottoNum
    Dim i As Long, j As Long
    Dim arrData, rngData As Range
    lastRow = 1000
    stopRunUp = 0
    Set rngData = Range("A1:H" & lastRow)
    arrData = rngData.Value
    For i = LBound(arrData) + 1 To UBound(arrData)
        lottoNum = arrData(i, 3)
        If lottoNum = 3957481 Then
            arrData(2, 6) = arrData(i, 1)
            arrData(2, 7) = arrData(i, 2)
            arrData(2, 8) = lottoNum
            MsgBox ("Congratulations " + Str(arrData(2, 6)) + " " + Str(arrData(2, 7)))
        ElseIf lottoNum = 5865187 Then
            arrData(3, 6) = arrData(i, 1)
            arrData(3, 7) = arrData(i, 2)
            arrData(3, 8) = lottoNum
        ElseIf lottoNum = 2817729 Then
            arrData(4, 6) = arrData(i, 1)
            arrData(4, 7) = arrData(i, 2)
            arrData(4, 8) = lottoNum
        ElseIf lottoNum = 2275339 And stopRunUp = 0 Then
            arrData(5, 6) = arrData(i, 1)
            arrData(5, 7) = arrData(i, 2)
            arrData(5, 8) = lottoNum
            stopRunUp = 1
        ElseIf lottoNum = 5868182 And stopRunUp = 0 Then
            arrData(5, 6) = arrData(i, 1)
            arrData(5, 7) = arrData(i, 2)
            arrData(5, 8) = lottoNum
            stopRunUp = 1
        ElseIf lottoNum = 1841402 And stopRunUp = 0 Then
            arrData(5, 6) = arrData(i, 1)
            arrData(5, 7) = arrData(i, 2)
            arrData(5, 8) = lottoNum
            stopRunUp = 1
        End If
    Next i
    rngData.Value = arrData
End Sub

0赞 Andrew Jessberger 11/2/2023

谢谢。如果我的格式难以阅读，也很抱歉。对此非常陌生。

0赞 Spencer Barnes 11/2/2023 #2

@Taller的回答非常好，也很正确。
但是，这可以更进一步，通过将中奖号码存储在数组中来消除对语句的需求。
然后，使用“嵌套循环”（循环中的循环）根据每个可能的中奖号码检查每个结果。ElseIf

虽然下面的代码并不比我修改的原始代码短多少，但它使它更容易阅读（所有可能的中奖号码都彼此相邻存储）并在将来添加/删除更多中奖号码。

Sub LottoSearch()
    Dim stopRunUp As Integer
    Dim lastRow As Long, lottoNum
    Dim i As Long, j As Long, a As Long
    Dim arrData, rngData As Range
    lastRow = 1000
    stopRunUp = 0

    'Store Winning numbers in an array
        'With StopRunup and MsgBox properties also in arrays
    Dim arrWinners(), arrStopRunup(), arrMsgBox()
        'Arrays must be the same length!
    arrWinners = Array(3957481, 5865187, 2817729, 2275339, 5868182, 1841402)
    arrStopRunup = Array(False, False, False, True, True, True)
    arrMsgBox = Array(True, False, False, False, False, False)

    Set rngData = Range("A1:H" & lastRow)
    arrData = rngData.Value

    For i = LBound(arrData) + 1 To UBound(arrData)
        lottoNum = arrData(i, 3)
        'Loop through winning numbers and check if they match.
        For j = LBound(arrWinners) To UBound(arrWinners)
            If lottoNum = arrWinners(j) And (stopRunUp = 0 Or arrStopRunup(j) = False) Then
                a = arrData(IIf(arrStopRunup(j), 5, j + 2)) 'working out which row to store in
                arrData(a, 6) = arrData(i, 1)
                arrData(a, 7) = arrData(i, 2)
                arrData(a, 8) = lottoNum
                If arrMsgBox(j) Then MsgBox "Congratulations " + Str(arrData(i, 1)) + " " + Str(arrData(i, 2))
                If arrStopRunup(j) Then stopRunUp = 1
            End If
        Next j
    Next i
    rngData.Value = arrData
End Sub

当然，没有客观上正确或错误的方法，如果你的代码有效，那么没有人会抱怨。你提到你是新手，所以我想我会添加我的提示！

顶级域名;数组很棒，嵌套循环也很酷，使用两者来尽可能避免重复指令。

上一个：直到在 for 循环中向后退步？

下一个：已在使用的控制变量 - 简单的 VBA 脚本

VBA 崩溃大约 700 次迭代 - 当我尝试将此 VBA 循环运行到 1000 秒（650 次是安全的）迭代时，Excel 不断崩溃。有什么想法吗？

VBA Crashing Around 700 Iterations - Excel keeps crashing when I try to run this VBA loop out to 1000s, (650 is safe) iterations. Any thoughts?

评论

评论