Question

我有以下Excel表格：

Letter  Number
A       3741
B       14201
C       13503

我想浏览“字母列”，只要有相同的字母，请查看旁边的“数字列”，然后删除较小的值 - 仅保留最大值。

我希望最终结果是每个字母只有一个条目，旁边有相应的值，如下所示：

{{1}}

Answer 1

如果您的字母在A列中且数字在B列中，则以下代码应该起作用：

Sub FindMaxValue()

Dim CountLng As Long

'find range
CountLng = ActiveSheet.UsedRange.Rows.Count

'loop through range to find max
For x1 = CountLng To 2 Step -1
    For x2 = 2 To CountLng
        If Range("A" & x1).Value = Range("A" & x2).Value And x1 <> x2 Then
            If Range("B" & x1).Value >= Range("B" & x2).Value Then
                Rows(x2).EntireRow.Delete
                Exit for
            Else
                Rows(x1).EntireRow.Delete
                Exit For
            End If
        End If
    Next x2
Next x1

End Sub

Answer 2

您可以使用Dictionary来保存每个字母的最大值，然后使用AutoFilter()来删除＆＃34;更低的＆＃34;值字母行：

Option Explicit

Sub min()
    Dim rng As Range, cell As Range
    Dim key As Variant

    Set rng = Range("B1", Cells(Rows.Count, "A").End(xlUp))
    With CreateObject("Scripting.Dictionary")
        For Each cell In rng.Resize(rng.Rows.Count - 1, 1).Offset(1)
            If .Exists(cell.value) Then
                If cell.Offset(, 1) > .item(cell.value) Then .item(cell.value) = cell.Offset(, 1).value
            Else
                .Add cell.value, cell.Offset(, 1).value
            End If
        Next
        Application.DisplayAlerts = False
        For Each key In .Keys
            rng.AutoFilter field:=1, Criteria1:=key
            rng.AutoFilter field:=2, Criteria1:="<" & .item(key)
            rng.Resize(rng.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible).Delete
            rng.AutoFilter
        Next
        Application.DisplayAlerts = True
    End With
End Sub

有条件的行删除

2 个答案: