|
▼laihu さん:
関数は独覚さんにおまかせし、VBA処理の一案です。
Sub Test()
Dim dic As Object
Dim c As Range
Set dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Sheets("Sheet1")
For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
If Not dic.exists(c.Value) Then Set dic(c.Value) = CreateObject("Scripting.Dictionary")
dic(c.Value)(dic(c.Value).Count) = c.Offset(, 1).Value
Next
End With
With Sheets("Sheet2")
.Range("A1", .UsedRange).Offset(1, 4).ClearContents
For Each c In .Range("D2", .Range("D" & Rows.Count).End(xlUp))
If dic.exists(c.Value) Then c.Offset(, 1).Resize(, dic(c.Value).Count).Value = dic(c.Value).items
Next
.Select
End With
End Sub
|
|