в цикле VBA For выполнение останавливается примерно после 530 итераций

Question

Я написал простой код для своих задач, связанных с работой, но он останавливается без каких-либо сообщений об ошибках на 530 итерации, хотя у меня все еще есть некоторые данные, которые должны быть обработаны.

Попытался удалить весь код вVBA и вставьте его из блокнота.Пробовал отладчик.Пробовал перезапуск Excel и ПК.

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

Спасибо, ребята.Я реализовал многое из ваших предложений, и теперь этот код делает то, что я хотел.:)

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

Answer 2

Ваш пересчет 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, а также увеличить его вручную i = i + 1.На этот раз вступают в силу изменения iEnd = 20, и цикл запускается с 1 … 20, поскольку цикл Do оценивает условие i <= iEnd на на каждой итерации (не только на старте, как Forцикл делает).

Альтернатива

Другое решение (если вы вставляете или удаляете строки) - запустить цикл в обратном направлении:

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 каждый раз, когда вы вставляете строку, что будет намного быстрее, чем определение последней строки снова и снова.