エクセルでのマクロを使ったデータの並べ替え

エクセルでのデータの並べ替えについて質問です。
以下のようにA、B列に縦に並んでいるデータを、A列の値が同じもの同士で区切って横に並べていくというのをマクロでできないかと試しているのですがなかなかうまくいきません。
どなたかお知恵を貸していただけないでしょうか。よろしくお願いします。

A列　B列
a　　100
a　　150
a　　200
b　　180
b　　110
c　　120
c　　160

↓

A列　B列　C列　D列　E列　F列
a　　100　b　　180　c　　120
a　　150　b　　110　c　　160
a　　200

質問者からの補足コメント

• ありがとうございます。
  バラバラにはなっておらず、必ずひとかたまりになっています。

  No.1の回答に寄せられた補足コメントです。 補足日時：2022/12/03 20:30

No.2 ベストアンサー 回答者： zongai 回答日時： 2022/12/03 20:42

これで、できたっぽい。

Sub sample()
　　Dim i As Long, j As Long
　　i = 1
　　j = 1
　　Do While Cells(i + 1, j) <> ""
　　　　If Cells(i, j) <> Cells(i + 1, j) Then
　　　　　　Range(Cells(i + 1, j), Cells(Cells(Rows.Count, j).End(xlUp).Row, j + 1)).Cut Cells(1, j + 2)
　　　　　　i = 0: j = j + 2
　　　　End If
　　　　i = i + 1
　　Loop
End Sub

この回答へのお礼

ありがとうございます！
できました！
なるほど、そうすればいいんですね。

お礼日時：2022/12/04 07:49

No.3 回答者： tatsumaru77 回答日時： 2022/12/03 20:47

元のデータのシート名をSheet1、

並べ替えた結果のシート名をSheet2とします。
以下のマクロを標準モジュールに登録して下さい。

Public Sub 並べ替え()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow As Long
Dim wrow As Long
Dim row2 As Long
Dim col2 As Long: col2 = -1
Dim key As String
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh2.Cells.ClearContents
maxrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row
key = ""
prev_key = ""
For wrow = 1 To maxrow
key = sh1.Cells(wrow, "A").Value
If key <> prev_key Then
row2 = 1
col2 = col2 + 2
End If
sh2.Cells(row2, col2).Resize(, 2).Value = sh1.Cells(wrow, "A").Resize(, 2).Value
row2 = row2 + 1
prev_key = key
Next
MsgBox ("完了")
End Sub

この回答へのお礼

ありがとうございます！
できました！

お礼日時：2022/12/04 07:49

No.1 回答者： tatsumaru77 回答日時： 2022/12/03 20:23

A列のa,b,cは１つのかたまりになっていますが、

添付図のようにバラバラになっている可能性はありますか。