Excel VBA：根据列中的副本优化代码以删除行

我试图想出一个精益和错误校验的macros来删除列A中包含重复值的行。我有两个解决scheme，都有其优点。 没有一个是我想要的。

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

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

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

2. 这一个从底部删除重复。 它比第一个持续时间更长（我有大约6k行）但是这个问题是它并没有全部删除它们。 一些重复项被留下，并在我再次运行相同的代码后被删除。 甚至还有更less的重复。 基本上需要运行它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 

“有没有办法改进这些工作，或者有更好的解决scheme？ 任何信息非常感谢。 谢谢

Answer 1

这个概念是正确的，但请记住，删除行时， Cells(n1 + 1, 1)不会与删除行之前的Cells(n1 + 1, 1)相同。 解决scheme是简单地颠倒循环，并从底部到顶部testing行：

 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")取消引用，这也将提高性能。

如果它仍然运行得太慢，下一步就是将行标记为删除，在标记上sorting，在一个操作中删除整个标记的范围，然后重新sorting。 我猜上面的代码应该足够快〜6K行。

Answer 2

最简单的方法是一次删除所有行。 同样为了提高速度，你最好用variables进行检查，而不是像这样的实际单元格值：

 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