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

Question

我在 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

Answer 1

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

.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

最后，我假设您实际上有行 header。确实没有任何理由使用 xlGuess。要么你有要么没有。

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

Remove Duplicate Values - Using Data In 2 Columns & Removing Lowest Value

excel

vba