| 
    
     |  | ▼秋刀魚 さん: こんにちは。
 
 別法ですが、こんなのどうでしょうか
 (結果は E1以降に出力しています)
 
 Sub Try1()
 Dim v, s As String
 Dim i As Long
 Dim dic As Object
 Set dic = CreateObject("Scripting.Dictionary")
 With ActiveSheet
 v = .Range("A1", _
 .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2).Value
 dic(v(1, 2)) = v(1, 1)
 For i = 2 To UBound(v)
 s = v(i, 2)
 If dic.Exists(s) Then
 If dic(s) < v(i, 1) Then dic(s) = v(i, 1) '大きいほうを記憶
 Else
 dic(s) = v(i, 1)
 End If
 Next
 .Range("E1").Resize(dic.Count, 2).Value = _
 Application.Transpose(Array(dic.Keys, dic.Items))
 End With
 Set dic = Nothing
 End Sub
 
 |  |