• ベストアンサー
  • 困ってます

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

  • 質問No.5622152
  • 閲覧数49
  • ありがとう数4
  • 回答数2

お礼率 65% (170/259)

こんにちは。いつもお世話になっております。
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つの列にまとめ、複数契約がある場合は行を追加して、お客様:商品=多:1の表にしたいのです。

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

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

質問者が選んだベストアンサー

  • 回答No.1
  • ベストアンサー
こんなもんでどうでしょう?


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
お礼コメント
camo-tech

お礼率 65% (170/259)

お礼が遅くなりました。

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

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

また、機会がございましたらよろしくお願いします。
投稿日時:2010/01/26 09:47

その他の回答 (全1件)

  • 回答No.2
   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)
お礼コメント
camo-tech

お礼率 65% (170/259)

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

#1さんの回答でうまく行きました^^;
投稿日時:2010/01/26 09:49
関連するQ&A

その他の関連するQ&Aをキーワードで探す

ピックアップ

ページ先頭へ