Excel2002 同一列内に存在する複数データの取り出し方法

質問

こんにちは。いつもお世話になっております。
ExcelからAccessにデータ移行する際、Excelのデータフォーマットを変更する必要があり、質問させていただきました。

下記のようなSheetがあります。
氏名ID＝お客様IDのことです。
○月加入＝加入した月ごとに列があります。（下記では3月まで）
中身のデータ（A001等）＝商品コードをあらわします。
---------------------------------------------------
　　氏名ID　　1月加入　2月加入　3月加入
1　　0001　　　A001
2　　0002　　　　　　　A001　　　B001
3　　0003　　　　　　　B001
---------------------------------------------------
このSheetを、下記のように変換したいのです。
---------------------------------------------------

　　氏名ID　　1月加入　2月加入　3月加入　　契約商品
1　　0001　　　A001　　　　　　　　　　　　A001
2　　0002　　　　　　　A001　　　　　　　　A001
3　　0002　　　　　　　　　　　　B001　　　B001
4　　0003　　　　　　　B001　　　　　　　　B001
----------------------------------------------------

上記のように変換できたら、各月の部分は削除し、お客様IDと商品IDだけのSheetにするつもりです。

要は、一人のお客様が加入している契約商品を、1つの列にまとめ、複数契約がある場合は行を追加して、お客様：商品＝多：１の表にしたいのです。

マクロ、VBAなど、組み合わせでもかまいませんが、このような我侭な要求が達成できますでしょうか?

達人の方々、よろしくお願いいたします。

回答No.1

noname#130090 · ベストアンサー

こんなもんでどうでしょう？

Sub siwake()
　　Dim i As Long, j As Long, k As Long
　　Dim cstm As String
　　Dim startM As Integer, endM As Integer

　　'1月startなので
　　startM = 1
　　'3月endなので
　　endM = 3

　　Do While Range("A2").Offset(i) <> ""
　　　　cstm = Range("A2").Offset(i)
　　　　For j = startM To endM
　　　　　　　　If Range("A2").Offset(i, j) <> "" Then
　　　　　　　　　　Range("G2").Offset(k) = cstm
　　　　　　　　　　Range("G2").Offset(k, j) = Range("A2").Offset(i, j)
　　　　　　　　　　Range("G2").Offset(k, endM + 1) = Range("A2").Offset(i, j)
　　　　　　　　　　k = k + 1
　　　　　　　　End If
　　　　Next
　　　　i = i + 1
　　Loop
End Sub

お礼

お礼が遅くなりました。

ご回答のソースをちょっとだけいじり、実行した結果、バッチリうまく動いてくれました。

Accessへの取り込みもうまく行き、非常に喜んでおります。

また、機会がございましたらよろしくお願いします。

回答No.2

noname#204879

A　　　　B　　　　C　　　　D　　　　E
1　氏名ID　1月加入　2月加入　3月加入　契約商品
2　0001　　A001　　　　　　　　　　　 A001
3　0002　　　　　　 A001　　　　　　　A001
4　0002　　　　　　　　　　　B001　　 B001
5　0003　　　　　　 B001　　　　　　　B001

E2: =LOOKUP("黑",B2:D2)

お礼

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

＃１さんの回答でうまく行きました＾＾；