|
▼秋刀魚 さん:
こんにちは。
別法ですが、こんなのどうでしょうか
(結果は 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
|
|