Excel VBA：优化代码以根据列中的重复项删除行

Question

我正在尝试提出一个精简且防错的宏来删除 A 列中包含重复值的行。我有两种解决方案，并且都有它们的优点。它们都不是我想要的。

我需要删除包含重复项的行，但保留包含重复项的最后一行。

1. 这个太棒了。它没有循环并且可以立即工作。问题是它删除了包含重复项的后续行，因此留下了第一次出现的重复项（我需要最后一个/或第二个 - 大多数只显示两次）

   Sub Delete() ActiveSheet.Range("A:E").RemoveDuplicates Columns:=1, Header:=xlNo End Sub

2. 这个从底部开始删除重复项。它比第一个持续时间更长（我有大约 6k 行）但是这个问题是它不会全部删除它们。留下了一些重复项，并且在我再次运行相同的代码后将它们删除。甚至还剩下更少的复制品。基本上需要运行它多达 5 次，然后我最终得到了干净的列表。

   `

   Sub DeleteDup()

     Dim LastRowcheck As Long, n1 As Long, rowschecktodelete As Long
   
     LastRowcheck = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
   
     For n1 = 1 To LastRowcheck
       With Worksheets("Sheet1").Cells(n1, 1)
         If Cells(n1, 1) = Cells(n1 + 1, 1) Then
           Worksheets("Sheet1").Cells(n1, 1).Select
           Selection.EntireRow.Delete
        End If
      End With
     Next n1
   
     End Sub
   

` 有没有办法改进其中的任何一个以使其正常工作，或者有更好的解决方案吗？非常感谢任何信息。谢谢

Answer 1

最简单的方法是一次删除所有行。此外，为了提高速度，您最好使用变量而不是像这样的真实单元格值进行检查：

Sub DeleteDup()

  Dim LastRowcheck As Long
  Dim i As Long
  Dim rows_to_delete As Range
  Dim range_to_check As Variant

  With Worksheets("Sheet1")
    LastRowcheck = .Cells(Rows.Count, 1).End(xlUp).Row
    range_to_check = .Range("A1:A" & LastRowcheck).Values

    For i = 1 To LastRowcheck - 1
      If range_to_check(i, 1) = range_to_check(i + 1, 1) Then
        If rows_to_delete Is Nothing Then
          Set rows_to_delete = .Cells(i, 1)
        Else
          Set rows_to_delete = Union(.Cells(i, 1), rows_to_delete)
        End If
      End If
    Next n1
  End With

  rows_to_delete.EntireRow.Delete

End Sub

Answer 2

这个概念是正确的，但请记住，当您删除行时，Cells(n1 + 1, 1) 与删除行之前的情况不同。解决方案是简单地反转循环并从下到上测试行：

Sub DeleteDup()
    Dim last As Long
    Dim current As Long
    Dim sheet As Worksheet

    Set sheet = Worksheets("Sheet1")
    With sheet
        last = .Range("A" & .Rows.Count).End(xlUp).Row
        For current = last To 1 Step -1
            If .Cells(current + 1, 1).Value = .Cells(current, 1).Value Then
                .Rows(current).Delete
            End If
        Next current
    End With
End Sub

请注意，您可以使用循环计数器来索引.Rows，而不是使用Selection 对象来显着提高性能。此外，如果您获取对 Worksheet 的引用并将整个内容放入 With 块中，您不必不断取消引用 Worksheets("Sheet1")，这也将提高性能。

如果它仍然运行得太慢，下一步是标记要删除的行，对标记进行排序，在一次操作中删除整个标记范围，然后排序回原始顺序。我猜上面的代码应该足够快，可以处理约 6K 行。