代碼已正確執行時陷入循環

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並創建一個永恆的循環。