在 VBA 中 For 循环在大约 530 次迭代后停止执行

Question

我已经为我的工作相关任务编写了简单的代码，但它在 530 迭代时停止执行而没有任何错误消息，而我仍有一些数据需要处理。

试图删除 VBA 中的所有代码并从记事本粘贴。试过调试器。尝试重启excel和pc。

Function CoRow() As Long
    CoRow = Cells(Rows.Count, 1).End(xlUp).Row
End Function

Sub Sort()
    Dim LastNace As Integer
    Dim NextNace As Integer
    Dim i As Long
    LastNace = Cells(2, "C").Value
    NextNace = Cells(3, "C").Value
    Columns("A:E").Select
    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("E2"), Order2:=xlDescending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    For i = 1 To CoRow
        If LastNace <> NextNace And LastNace <> 0 And NextNace <> 0 And i <> 1 Then
            Rows(i + 1).EntireRow.Insert
            Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Color = RGB(255, 255, 0)
            i = i + 1
        ElseIf LastNace <> NextNace And LastNace <> 0 And NextNace = 0 And i <> 1 Then
            Rows(i + 1).EntireRow.Insert
            Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Color = RGB(255, 255, 0)
            i = i + 1
        End If
        LastNace = Cells(i + 1, "C").Value
        NextNace = Cells(i + 2, "C").Value
        'Range(Cells(i + 1, 3).Address(), Cells(i + 1, 3).Address()).Interior.Color = RGB(255, 0, 0)
    Next i
End Sub

预期结果是超过 530 次迭代。我怀疑排序有问题，因为在执行此代码之前它也对相同数量的行进行排序。

Answer 1

您对CoRow 的重新计算不会影响循环结束！

注意在For循环中，一旦循环开始

For i = 1 To CoRow

CoRow 的任何值更改不会影响循环结束！ For 循环始终使用循环开始时设置的CoRow 的值。

以下示例：

Dim i As Long
Dim iEnd As Long
iEnd = 10

For i = 1 To iEnd
    iEnd = 20 'this has NO EFFECT on the end of the For loop
    Debug.Print i, iEnd
Next i

此循环将仅从 1 … 10 运行，因为一旦循环以 For i = 1 To iEnd 开始，iEnd = 20 的任何更改都不会影响循环的结束。

---

解决方案

将其替换为 Do 循环。

Dim i As Long
Dim iEnd As Long
iEnd = 10

i = 1 'initialization needed before Do loops

Do While i <= iEnd
    iEnd = 20
    Debug.Print i, iEnd

    i = i + 1 'manual increase of counter needed in the end of Do loops
Loop

请注意，对于Do 循环，您需要初始化计数器i = 1 并手动增加它@9​​87654335@。这次iEnd = 20 的更改生效并且循环从1 … 20 运行，因为Do 循环在每次 迭代中评估条件i <= iEnd（不仅在开始时作为@987654340 @loop 确实如此）。

另类

另一种解决方案（如果您插入或删除行）是向后运行循环：

Dim CoRow As Long 'make it a variable not a function then
CoRow = Cells(Row.Count, 1).End(xlUp).Row

Dim i As Long
For i = CoRow To 1 Step -1
    'runs backwards starting at the last row ending at the first
Next i

但这是否可能取决于您的数据以及您在循环中执行的操作。

---

改进

请注意，CoRow = Cells(Rows.Count, 1).End(xlUp).Row 会占用一些时间。与其将CoRow 设为函数，不如将其设为变量，每次插入一行时将其增加1 CoRow = CoRow + 1，这将比一遍又一遍地确定最后一行要快得多。

Answer 2

谢谢各位。我从你的建议中实现了很多，现在这段代码做了我想做的事情。 :)

Function CoRow() As Long
CoRow = Cells(Rows.count, 1).End(xlUp).Row
End Function

Sub Sort()
Dim LastNace As Integer
Dim NextNace As Integer
Dim CountNace As Integer
Dim r As Long
Dim i As Long
Sheets("Imp").Range("A:E").Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("E2"), Order2:=xlDescending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
LastNace = Sheets("Imp").Cells(2, "C").Value
NextNace = Sheets("Imp").Cells(3, "C").Value
r = CoRow
CountNace = 0
For i = 1 To r
    If LastNace <> NextNace And LastNace <> 0 And NextNace <> 0 Then
        CountNace = CountNace + 1
    End If
    LastNace = Sheets("Imp").Cells(i + 1, "C").Value
    NextNace = Sheets("Imp").Cells(i + 2, "C").Value
Next
r = r + CountNace
LastNace = Sheets("Imp").Cells(2, "C").Value
NextNace = Sheets("Imp").Cells(3, "C").Value
For i = 1 To r
    If LastNace <> NextNace And LastNace <> 0 And NextNace <> 0 And i <> 1 Then
        Sheets("Imp").Rows(i + 1).EntireRow.Insert
        Sheets("Imp").Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Color = RGB(255, 255, 0)
        i = i + 1
    ElseIf LastNace <> NextNace And LastNace <> 0 And NextNace = 0 And i <> 1 Then
        Sheets("Imp").Rows(i + 1).EntireRow.Insert
        Sheets("Imp").Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Color = RGB(255, 255, 0)
        i = i + 1
    End If
    LastNace = Sheets("Imp").Cells(i + 1, "C").Value
    NextNace = Sheets("Imp").Cells(i + 2, "C").Value
    'Sheets("Imp").Range(Cells(i + 1, 3), Cells(i + 1, 3)).Interior.Color = RGB(255, 0, 0)
Next
End Sub