删除重复值 - 使用2列中的数据&删除最低价值

时间:2015-01-14 16:16:18

标签: excel vba excel-vba

我在列E中有重复值。列D中有数字。使用这两列,我需要在E列中找到重复项,并从结果中删除编号最小的那些。

我一直在尝试下面的代码,我在网上找到了,但我不确定哪些值需要更改才能使其适用于我的文档。第1行包含列标题。此外,当运行以下代码时,我收到一条错误消息。

Sub remdup()
    Dim ws As Worksheet, LR As Long, i As Long, LC As Integer
    LR = Cells(Rows.Count, “A”).End(xlUp).Row
    LC = Cells(1, Columns.Count).End(xlToLeft).Column
    Range(Cells(1, 1), Cells(LR, LC)).Sort Key1:=Cells(1, 8), Order1:=xlDescending, _
    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    For i = LR To 2 Step -1
        If WorksheetFunction.CountIf(Columns(1), Cells(i, 1).Value) > 1 Then Rows(i).Delete
    Next i
    Range(Cells(1, 1), Cells(LR, LC)).Sort Key1:=Cells(1, 1), Order1:=xlDescending, _
    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

1 个答案:

答案 0 :(得分:1)

我添加了一个With ... End With块,允许您将父工作表分配给所有单元格引用。

.RemoveDuplicates命令远远优于遍历行并在计数大于1时删除它们。删除重复项始终从下到上删除,只要数据已在D列中排序即可下降的方式,你应该没事。

Sub remdup()
    Dim ws As Worksheet, LR As Long, LC As Integer

    Set ws = Sheets("Sheet1")    '<< change this to the name of the worksheet
    With ws
        LR = .Cells(Rows.Count, 1).End(xlUp).Row
        LC = .Cells(1, Columns.Count).End(xlToLeft).Column
        With .Cells(1, 1).Resize(LR, LC)
            .Sort Key1:=.Columns(4), Order1:=xlDescending, _
                Orientation:=xlTopToBottom, Header:=xlYes
            .RemoveDuplicates Columns:=5, Header:=xlYes
            .Sort Key1:=.Columns(1), Order1:=xlDescending, _
                Orientation:=xlTopToBottom, Header:=xlYes
        End With
    End With
    Set ws = Nothing
End Sub

最后,我假设您实际上拥有标题行。没有任何理由可以使用xlGuess。要么你有一个。

相关问题