|
C列D列には重複はないのでしょうか?
重複がないのであれば、こんな感じで出来ると思います。
Sub test()
Dim myDic As Object
Dim r As Range, rr As Range
Application.ScreenUpdating = False
With Sheets("Sheet1")
Set myDic = CreateObject("Scripting.Dictionary")
For Each r In .Range("C1", .Range("C65536").End(xlUp))
myDic(r.Value) = r.Offset(, 1).Value
Next
.Range("C:D").ClearContents
For Each rr In .Range("A1", .Range("A65536").End(xlUp))
For Each mykey In myDic.Keys
If rr.Value = mykey Then
rr.Offset(, 2).Value = mykey
rr.Offset(, 3).Value = myDic(mykey)
End If
Next
Next
End With
Application.ScreenUpdating = True
End Sub
|
|