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

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

我看到两件事：

首先：你做一个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

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

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

Answer 3

问题可能出在：

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

Statement 被设置为true，如果还有重复的话。它需要检查，如果没有剩余，然后将其设置为false