删除重复VBA

时间:2017-12-05 20:28:43

标签: excel 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

谢谢,

3 个答案:

答案 0 :(得分:1)

从下往上工作并循环直到所有更高的' (即连续小于当前的行)被删除。

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

这将需要比绝对必要的更多周期,但操作足够有效,不会产生显着差异。

答案 1 :(得分:0)

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

我认为这将从底部开始,将第一个值放在变量中,然后将通过列表的其余部分检查值以查看是否兼容。可能需要调整第二个for循环。

答案 2 :(得分:0)

不是一个漂亮的答案 - 但从它的外观来看,你应该以最后一次和第一次出现的副本结束:

 Column A    Column B
 A           1
 A           3

要修改你的答案(有更优雅的方法),你可以在循环结束后再次找到最后一行并检查最后一个副本:

 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