EXCELのVBAで困っています。

質問

うまくかけないので、イメージを下に書かせていただきます、。

　|　　A　　|　　B　　｜
----------------------
1 | 東京　　　150
2 |　埼玉　　　150
3 |　千葉　　　150
4 |　群馬　　　120
5 |　東京　　　120
6 | 静岡　　　110
　　↓
　|　　A　　|　　B　　｜
------------------------
　| 東京
1 |　埼玉　　　150
　|　千葉
------------------------
2 |　群馬　　　120
　|　東京
------------------------
3 | 静岡　　　110

上記のような処理をVBAで行いたいのですが、どのように
書いたらよいかを、教えてください。お願いします。

回答No.1

Wendy02

こんばんは。

以下は、シート2に書き出すように作られています。

Sub TestStandarizing()
　　Dim objDic As Object ' New Dictionary
　　Dim c As Variant
　　Dim i As Long
　　Set objDic = CreateObject("Scripting.Dictionary")
　　For Each c In Range("A1", Range("A65536").End(xlUp))
　　　　If VarType(c.Offset(, 1).Value) Or vbDouble = vbDouble Then
　　　　　　If objDic.Exists(c.Offset(, 1).Value) Then
　　　　　　　　objDic.Item(c.Offset(, 1).Value) = _
　　　　　　　　objDic.Item(c.Offset(, 1).Value) & vbLf & c.Value
　　　　　　Else
　　　　　　　　objDic.Add c.Offset(, 1).Value, c.Value
　　　　　　End If
　　　　End If
　　Next c

　　i = objDic.Count
　　'シート2への書き出し（本来はループで可）
　　Worksheets("Sheet2").Range("A1").Resize(i).Value = _
　　　　WorksheetFunction.Transpose(objDic.Items)
　　Worksheets("Sheet2").Range("B1").Resize(i).Value = _
　　　　WorksheetFunction.Transpose(objDic.Keys)
　　Set objDic = Nothing
End Sub