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

Question

我试图想出一个精益且防错误的宏来删除列A中包含重复值的行。我有两种解决方案，它们都有各自的优点。他们都不是我想要的。

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

1. 这个太棒了。它没有循环，并且可以即时工作。问题是，它删除了包含重复项的后续行，从而留下了重复的第一次出现(我需要最后/或第二次--大多数只显示两次)。 Sub Delete() ActiveSheet.Range("A:E").RemoveDuplicates Columns:=1, Header:=xlNo End Sub
2. 这一个从底部删除重复。它的持续时间比第一个(我有大约6k行)，但问题是，它没有删除他们全部。在我再次运行相同的代码后，会留下一些副本，并将它们删除。还有更少的被杀者还在。基本上需要运行5次，然后我得到干净的列表。 ` 亚DeleteDup() Dim LastRowcheck As Long，n1 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)然后工作表(n1，1)Sheet1(Sheet1，1) End 20#结束，如果以下一个结束

“是否有办法改进这些方法，使其发挥更好的作用，还是有更好的解决办法？任何信息都是非常感谢的。谢谢

Answer 1

这个概念是正确的，但请记住，当您删除行时，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行。

Answer 2

最简单的方法是一次删除所有行。另外，为了提高速度，最好用变量而不是实际的单元格值进行检查，如下所示：

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