代码已正确执行时陷入循环

Question

如果满足特定条件（E 列），我编写了以下代码来清除重复数据集。 它扫描 1216 行数据（LastRow 有 1216 个命中）并清除重复项。 我唯一的问题是，如果我有两个或三个重复项，它只会删除一个重复项。

我写了另一行代码，说明如果多次找到一个项目（B 列），则称为 statement 的变量等于 TRUE。 所以我希望循环继续，直到数据集中没有重复项，这也会将变量变为 FALSE 并停止循环。 然而，循环无限地继续。 当我手动停止脚本时，它似乎已经清除了所有重复项。

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

您在循环内没有任何地方将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

Answer 2

问题可能出在：

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

如果还有重复项，则Statement设置为true 。 它需要检查，如果没有剩下，然后将其设置为false

Answer 3

我看到两件事：

首先：你做一个Do Until Statement<>True 。 但是在您的代码中，没有任何东西可以改变Statement的值。 在第一次运行代码时，当 VBA 第一次初始化 de 变量时，是的，默认值将是False ，但随后您的代码会更改此处的值：

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

所以这个条件很可能没有得到满足。

建议：当您使用If...then时，如果只有一个语句并且没有Else部分，您可以在 1 行中输入所有内容。 这意味着您上面的代码可以像这样恢复：

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

在上面的代码中，您正在循环遍历 rng 中的每个单元格rng. 之前，你做了Set Rng = ws1.Range(("D1"), ws1.Range("D1").End(xlDown)) 。 但是后来您删除了行，并且您从未更新rng 。 这意味着rng中可能有几个空白值，因为您在删除之前分配了范围。

因为有几个空白值， WorksheetFunction.CountIf(Rng, cell.Value)将返回总是大于1，使得Statement=True并创建一个永恒的循环。