必要に迫られて。。。
<コード>
Sub 同一項目縦から横列へ()
Dim i1, i2 As Range
Dim oj1, oj2 As String
'コードスタート位置
Set i1 = Range("A1")
'展開位置
Set i2 = Range("g1")
'同一項目縦から横列へ
Do Until i1.Value = ""
If oj1 = "" Then
oj1 = i1.Value
oj2 = i1.Offset(, 1).Value
ElseIf i1.Value = oj1 Then
oj2 = oj2 & "、" & i1.Offset(, 1).Value
Else
i2.Value = oj1
i2.Offset(, 1).Value = oj2
Set i2 = i2.Offset(1)
oj1 = i1.Value
oj2 = i1.Offset(, 1).Value
End If
Set i1 = i1.Offset(1)
Loop
If oj1 <> "" Then
i2.Value = oj1
i2.Offset(, 1).Value = oj2
End If
End Sub