エクセル VBA 複数のセルを一つにまとめたい

ぜひお知恵をお貸しください。宜しくお願いします。

商品番号　　デザイン　　枝番
００１　　　　　A型　　　　　-A
００１　　　　　B型　　　　　-B
００２
００３　　　　　レッド　　　　-RD
００３　　　　　ブルー　　　　-BL
００３　　　　　イエロー　　　-YW
００４

上記のようなリストがあります。
デザインと枝番を一つのセルにまとめて、以下の形にしなければならないのですが

００１　　デザイン：A型=001-A&デザイン：B型=001-B
００２
００３　　デザイン：レッド=003-RD&デザイン：ブルー=003-BL&デザイン：イエロー=003-YW
００４

VBAでできますでしょうか？

No.1 ベストアンサー 回答者： nishi6 回答日時： 2014/07/14 23:36

こんな感じでしょうか。

商品番号は数字にしています。（書式が000）


Sub Matome()
　　Dim Rw As Long
　　Dim outRw As Long
　　Dim strSet As String
　　
　　Rw = 1
　　With Range("A1")
　　　　While .Offset(Rw, 0) <> ""
　　　　　　If .Offset(Rw, 1) <> "" Then
　　　　　　　　strSet = .Offset(Rw, 0).Text & " " & _
　　　　　　　　　　　　"デザイン：" & .Offset(Rw, 1) & "=" & _
　　　　　　　　　　　　.Offset(Rw, 0).Text & .Offset(Rw, 2)
　　　　　　　　While .Offset(Rw, 0) = .Offset(Rw + 1, 0)
　　　　　　　　　　Rw = Rw + 1
　　　　　　　　　　strSet = strSet & "＆" & _
　　　　　　　　　　　　　　 "デザイン：" & .Offset(Rw, 1) & "=" & _
　　　　　　　　　　　　　　 .Offset(Rw, 0).Text & .Offset(Rw, 2)
　　　　　　　　Wend
　　　　　　Else
　　　　　　　　strSet = .Offset(Rw, 0).Text
　　　　　　End If
　　　　　　
　　　　　　outRw = outRw + 1
　　　　　　.Offset(outRw, 4).NumberFormatLocal = "@"
　　　　　　.Offset(outRw, 4) = strSet

　　　　　　Rw = Rw + 1
　　　　Wend
　　End With
End Sub

この回答への補足

早々の回答ありがとうございました。
上記を実行して問題なく解決できました！
本当に助かりました、どうもありがとうございます！！

補足日時：2014/07/15 13:01

この回答へのお礼

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

お礼日時：2014/07/15 13:03