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

I am trying to come up with a lean and error-proofed macro to delete rows containing duplicate values in a column A. I have two solutions and both have their advantages. None of them are exactly what I want.

我试图想出一个精简且防错的宏来删除列A中包含重复值的行。我有两个解决方案,两者都有其优点。它们都不是我想要的。

I need rows containing duplicates deleted but leaving the last row that contained the duplicate.

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

1. This one is awesome. It has no loop and works instantaneously. The problem is that it deletes subsequent rows containing duplicates hence leaving the first occurrence of the duplicate (And I need the last/ or second - most show up only twice)

   这个太棒了。它没有循环,可以即时工作。问题是它删除了包含重复的后续行,因此留下第一次出现的副本(我需要最后一次/或第二次 - 最多只显示两次)

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

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

2. This one goes from the bottom and deletes duplicates. It lasts longer than the first one ( I have around 6k rows) But the issue with this one is that it doesnt delete them all. Some duplicates are left and they are deleted after I run the same code again. Even smaller number of duppes is still left. Basically need to run it up to 5 times and then I end up with clean list.

   这个从底部开始删除重复项。它比第一个持续时间更长(我有大约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
   

` Is there a way to improve any of these to work well or is there a better solution? Any info is greatly appreciated. Thanks

“有没有办法改善其中任何一个能够正常工作,还是有更好的解决方案?非常感谢任何信息。谢谢

2 个解决方案

#1

The concept is right, but remember that when you delete rows, Cells(n1 + 1, 1) isn't going to be the same thing as it was before you deleted a row. The solution is to simply reverse the loop and test rows from bottom to top:

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

Note that you can use the loop counter to index .Rows instead of using the Selection object to improve performance fairly significantly. Also, if you grab a reference to the Worksheet and toss the whole thing in a With block you don't have to continually dereference Worksheets("Sheet1"), which will also improve performance.

请注意,您可以使用循环计数器来索引.Rows,而不是使用Selection对象来显着提高性能。此外,如果您获取对工作表的引用并将整个内容丢弃到With块中,则不必持续取消引用Worksheets(“Sheet1”),这也将提高性能。

If it still runs too slow, the next step would be to flag rows for deletion, sort on the flag, delete the entire flagged range in one operation, then sort back to the original order. I'm guessing the code above should be fast enough for ~6K rows though.

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

#2

The easiest way would be to delete all rows at once. Also to increase speed, you better do your checks with variables and not with the real cell values like this:

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

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