| 
    
     |  | ▼おく さん: 
 こんにちは
 アップされた構成がSample1、別案としてSample2 です。
 
 Sub sample1()
 Dim i As Long
 Dim a As Long
 Dim b As Long
 Dim ii As Long
 
 i = 1
 a = 1
 b = 3
 ii = 1
 
 Do Until Cells(i, 1) = ""
 If a <> Cells(i, 1).Value Then
 ii = 1
 b = b + 1
 End If
 Cells(ii, b).Value = Cells(i, 2).Value
 a = Cells(i, 1).Value
 i = i + 1
 ii = ii + 1
 Loop
 
 End Sub
 
 Sub Sample2()
 Dim c As Range
 Dim x As Long
 Dim y As Long
 Dim old As Variant
 
 x = 3
 y = 1
 old = Range("A1").Value
 Columns("C").ClearContents
 
 For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
 If c.Value <> old Then
 x = x + 1
 y = 1
 Columns(x).ClearContents
 End If
 Cells(y, x).Value = c.Offset(, 1).Value
 old = c.Value
 y = y + 1
 Next
 
 End Sub
 
 |  |