VBA застрял в цикле, в то время как код был правильно выполнен

Question

Я написал следующий код, чтобы очистить набор данных от дубликатов, если он соответствует определенным критериям (столбец E). Он сканирует 1216 строк данных (LastRow имеет 1216 попаданий) и очищает дубликаты. Единственная проблема, с которой я столкнулся, заключалась в том, что если бы у меня было 2 или 3 дубликата, он удалил бы только 1 дубликат.

Поэтому я написал еще одну строку кода, в которой сообщалось, что если один элемент (столбец B) был найден несколько раз, то переменная с именемутверждение равно TRUE. Поэтому я хочу, чтобы цикл продолжался до тех пор, пока в наборе данных не будет дубликатов, что также превратит переменную в ЛОЖЬ и остановит цикл. Однако цикл, кажется, продолжается бесконечно. Когда я останавливал сценарий вручную, он, казалось, очистил все дубликаты, но сценарий все еще продолжается.

Может кто-нибудь сказать мне, что вызывает этот бесконечный цикл в моем сценарии?

Sub ClearDataSet()

Dim LastRow As Integer
Dim i As Integer
Dim Rng, cell As Range
Dim Statement As Boolean

Set ws1 = ThisWorkbook.Worksheets("sheet1")

Set Rng = ws1.Range(("D1"), ws1.Range("D1").End(xlDown))
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

ws1.Range("A1").CurrentRegion.Sort _
    key1:=ws1.Range("D1"), order1:=xlAscending, _
    Key2:=ws1.Range("E1"), order2:=xlAscending, Header:=xlYes

Do

    For i = 2 To LastRow

        If ws1.Cells(i, "D") = ws1.Cells(i + 1, "D") And _
            (ws1.Cells(i, "E") < ws1.Cells(i + 1, "E") Or ws1.Cells(i, "E") = ws1.Cells(i + 1, "E")) Then
             Rows(i).Delete

        End If

   Next i

   For Each cell In Rng
       If WorksheetFunction.CountIf(Rng, cell.Value) > 1 Then
           Statement = True
       End If
   Next cell

Loop Until Statement <> True

End Sub

РЕДАКТИРОВАТЬ: Настроенный (и более эффективный) скрипт после решения M Schalk

Sub ClearDataSet()

Dim LastRow As Integer
Dim i As Integer
Dim Rng, cell As Range
Dim Statement As Boolean

Dim StartTime As Long
Dim TimeElapsed As Long

StartTime = Timer

Set ws1 = ThisWorkbook.Worksheets("sheet1")

Set Rng = ws1.Range(("D1"), ws1.Range("D1").End(xlDown))
LastRow = Cells(Rows.Count, "A").End(xlUp).Row



ws1.Range("A1").CurrentRegion.Sort _
    key1:=ws1.Range("D1"), order1:=xlAscending, _
    Key2:=ws1.Range("E1"), order2:=xlAscending, Header:=xlYes


    For i = 2 To LastRow

    If ws1.Cells(i, "D").Value = "" Then
        GoTo OverStepcode
    ElseIf _
             ws1.Cells(i, "D") = ws1.Cells(i + 1, "D") And _
            (ws1.Cells(i, "E") < ws1.Cells(i + 1, "E") Or _
             ws1.Cells(i, "E") = ws1.Cells(i + 1, "E")) Then
             Rows(i).Delete
             i = i - 1
        End If

    Next i

OverStepcode:

TimeElapsed = Round(Timer - StartTime)
MsgBox "The code ran successfully in " & TimeElapsed & " seconds vbinformation"

End Sub

Answer 1

Возможно, проблема в этом:

For Each cell In Rng
    If WorksheetFunction.CountIf(Rng, cell.Value) > 1 Then
        Statement = True
    End If
Next cell

Statement устанавливается на true, если остаются дубликаты. необходимо проверить, не осталось ли ничего, а затем установить значение false

Answer 2

Я вижу две вещи:

Первое: вы делаете Do Until Statement<>True. Но в вашем коде нет ничего, что меняет значение Statement. При первом запуске кода, когда VBA инициализирует переменную de в первый раз, да, значение по умолчанию будет False, но затем ваш код изменяет значение здесь:

If WorksheetFunction.CountIf(Rng, cell.Value) > 1 Then
    Statement = True
End IF

Таким образом, условие, вероятно, невыполняется.

СОВЕТ: Когда вы используете If ...then, вы можете набрать все в одну строку, если есть только одна инструкция и нет части Else. Это означает, что ваш код, приведенный выше, может быть возобновлен следующим образом:

If WorksheetFunction.CountIf(Rng, cell.Value) > 1 Then Statement = True

Второе: это просто теория, я не проверял должным образом.

Ваш For Each, я думаю, что это не такработает правильно. У вас есть это:

For Each cell In Rng
    If WorksheetFunction.CountIf(Rng, cell.Value) > 1 Then
        Statement = True
    End If
Next cell

В приведенном выше коде вы зацикливаете torugh каждую ячейку в rng. А раньше вы делали Set Rng = ws1.Range(("D1"), ws1.Range("D1").End(xlDown)). Но позже вы удаляете строки, и вы никогда не обновляете rng. Это означает, что, вероятно, в rng есть несколько пустых значений, поскольку вы присвоили диапазон до удаления .

Поскольку имеется несколько пустых значений, WorksheetFunction.CountIf(Rng, cell.Value) всегда будет возвращать большечем 1, делая Statement=True и создавая вечный цикл.

Answer 3

Нигде внутри цикла вы не установите statement на False. Поэтому условие окончания цикла никогда не будет выполнено. Если я правильно понимаю вашу цель, вы должны добавить ее здесь:

    If ws1.Cells(i, "D") = ws1.Cells(i + 1, "D") And _
        (ws1.Cells(i, "E") < ws1.Cells(i + 1, "E") Or ws1.Cells(i, "E") = ws1.Cells(i + 1, "E")) Then
         Rows(i).Delete
         statement = False
    End If

Кроме того, Loop Until Statement <> True - это то же самое, что и Loop Until Statement = False, что, на мой взгляд, легче читать.

Вкл. отдельное примечание, это кажется слишком сложным подходом, вы пытались использовать Remove Duplicates?

В качестве еще одного более легкого решения вы можете удалить всю вещь statement и просто добавить i = i - 1 после обнаружения дубликата,Это гарантирует, что вы поймаете несколько дубликатов одного и того же значения, и вам не понадобится вся часть Do ... Loop. Попробуйте эту модифицированную версию.

For i = 2 To LastRow

    If ws1.Cells(i, "D") = ws1.Cells(i + 1, "D") And _
        (ws1.Cells(i, "E") < ws1.Cells(i + 1, "E") Or ws1.Cells(i, "E") = ws1.Cells(i + 1, "E")) Then
         Rows(i).Delete
         i = i - 1
    End If

Next i