删除重复的VBA

我试图从底部擦除重复的行，但它没有工作。 它保留两个副本，但删除其他重复的项目。

With wb_DST.Sheets(sWs_DST) lncheckduplicatescolumn = .Cells(.Rows.Count, "A").End(xlUp).row wb_DST.Sheets(sWs_DST).Range(("A13:A" & lncheckduplicatescolumn - 2 & ":" & "AW13:AW" & lncheckduplicatescolumn - 2)).Sort key1:=wb_DST.Sheets(sWs_DST).Range("A13:A" & lncheckduplicatescolumn - 2), order1:=xlDescending, Header:=xlNo Dim row As Range Dim rng As Range Dim cell As Range Dim i As Integer Set rng = wb_DST.Sheets(sWs_DST).Range("A13:A" & lncheckduplicatescolumn - 2) For Each cell In rng If cell.Value = cell.Offset(-1, 0).Value Then .cell.Offset(-1, 0).EntireRow.Delete End If Next End with 

如果Excel显示

 Column A Column B A 1 A 2 A 3 

我希望代码保留最后一行，并删除它上面的那一行。

结果应该是

 Column A Column B A 3 

谢谢，

Answer 1

从下往上循环，直到所有“更高”（即，比当前更less的一行）被删除。

 dim dup as variant, r as long, lncheckduplicatescolumn as long With wb_DST.Sheets(sWs_DST) lncheckduplicatescolumn = .Cells(.Rows.Count, "A").End(xlUp).row for r = lncheckduplicatescolumn to 2 step -1 dup = application.match(.cells(r, "A").value, .columns(1), 0) if dup < r then .rows(dup).delete next r end with 

这将需要几个周期比绝对必要的，但操作是有效的，不应该有显着的差异。

Answer 2

 Dim x as integer Dim y as string Dim J as integer Dim I as integer x = activesheet.range("A" & Activesheet.range("A1").endxl.down).count 'This will count the total number of rows. for i = x to 2 'this should count backwards from bottom to top, since you have headers, stop at row 2 y = Activesheet.range("A" & i).value 'places value in a variable For j = x - i - 1 to 1 'this is another loop, but it should start above the whatever the cell that Y got its value if activesheet.range("a" & j).value = y then 'comparison 'do what you need to delete the row end if Next Next 

我认为这将开始在底部，把第一个值在一个variables，然后将通过其余的清单检查值，看看是否兼容。 第二个for循环可能需要调整。

Answer 3

不是一个漂亮的答案 – 但从看起来像，你应该结束了重复的最后一次出现：

  Column A Column B A 1 A 3 

为了修补你的答案（有更优雅的方法），你可以在循环结束后再次find最后一行，并检查最后一个重复：

  For Each cell In rng If cell.Value = cell.Offset(-1, 0).Value Then .cell.Offset(-1, 0).EntireRow.Delete End If Next 

重新定义你的最后一行

  lncheckduplicatescolumn = .Cells(.Rows.Count, "A").End(xlUp).row 

并检查一个重复

  If Range("A" & lncheckduplicatescolumn).Value = Range("A" & lncheckduplicatescolumn).Offset(-1, 0).Value Then .cell.Offset(-1, 0).EntireRow.Delete End If