エクセル 同じ行にあるデータを複数行に分けたい

質問

エクセル上に入力してあるデータを添付画像のように変更したいです。

商品などのデータがエクセル上に入力してあり、現在は一行に一商品が対応しています。
商品が持っているオプション情報を同じ行の中に記載しています。
商品毎に持っているオプション情報の数が違うので、可変長ということになります。

画像では商品数やオプション数を少なく表示していますが、実際にはオプションは最大１４あります。
オプション情報がない商品は省略しても問題ありません。

自力でなんとかしようとエクセルと格闘していたのですが…
商品数×最大オプション数(14)　分の数の行を設定して、14行ごとに新しい商品名をvlookupして…と、力技を使わないと実現が難しいように思いました。
商品数が多いのと、逐次発生する作業であるという性質から、もう少し効率的に行う方法がないかと探しています。

方法をご存知の方、ご教示いただけないでしょうか。

使用しているのはMac版のExcel 2011ですが、Windows版の最新バージョンも使用できる環境です。
VBAの知識はほとんどありませんが、コードをコピペして一部改変したことならあります。
何卒宜しくお願いいたします。

回答No.3

imogasi · ベストアンサー

各々の商品の数が不定なので、ＶＢＡで考えるのがふさわしい（初等的に考えられる）
エクセル関数でもできないことはないように思うが。
ーー
Ｓｈｅｅｔ１に元データがあるとして
マクロ・ＶＢＡの入門本（ＷＥＢ）の初めをさんしょうしながら、やってください。
１．最終行番号を取得する（１）
２．第１行目から最終行まで１行ずつ、下記を繰り返す
Ｓｈｅｅｔ１の行ポインターを変数ｘとする
３．Ｂ列からデータのあるもっとも右の列まで１セルづつ繰り返す（２）
４．データがあれば「Ａ列データ＋当セルデータ」をＳｈｅｅｔ２に書き出す
５．書き出すときＳｈｅｅｔ２の行ポインター（Ｚとする）は１行書き出すと、次のために１つ下を指しておく。
（注）（１）、（２）は常套手段（ＶＢＡコード）がある。
ーー
Ｓｈｅｅｔ１に、元データのモデルデータとして（回答者の勝手で）
商品１ a1 a2
商品２ b1 b2 b3
商品３ c1 c2 c3 c4
商品４ d1
を作る。
ーー
結果はＳｈｅｅｔ２を使う。結果シートとする。
ーー
ＶＢＥ画面を開き（ＡＬＴ＋Ｆ１１）、メニューを選び、モジュールを挿入し、そのＭｏｄｕｌｅ１に
Sub test01()
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Z = 1
lr = sh1.Range("A100000").End(xlUp).Row
'MsgBox lr
For x = 1 To lr
cr = sh1.Cells(x, 100).End(xlToLeft).Column
MsgBox cr
For y = 2 To cr
sh2.Cells(Z, "A") = sh1.Cells(x, 1)
sh2.Cells(Z, "B") = sh1.Cells(x, y)
Z = Z + 1
Next y
Next x
End Sub
を作る。
（注）１０００００行や１００列は適当に、この問題ではありえないデータ数、列数などを使うもの。
ーー
実行すると
結果は、Ｓｈｅｅｔ２に
商品１ a1
商品１ a2
商品２ b1
商品２ b2
商品２ b3
商品３ c1
商品３ c2
商品３ c3
商品３ c4
商品４ d1

お礼

ありがとうございます。

丁寧に説明していただけたので、私の頭でもどうにか理解できました。
メッセージが何度も出てくる部分が私の環境では不要だったので、MsgBox の部分を消してみたところ、想定通りに動作しました。

補足

回答いただいた皆様、ありがとうございました。

いずれの方法でもこちらの望んだ出力が得られました。
少々悩みましたが、マクロについて丁寧に解説いただいたこちらをベストアンサーとさせていただきました。

回答No.5

imogasi

作業列（下記ではＧ列）を使わない方法の回答がすでに出ていますが、なかなか理解がむつかしいのではと思う。そこで
小生にとっては、理解しやすいと思う方法を上げてみます。
＜回答では列的にデータが左寄せになってわかりにくいと思うが、Ａ２－Ｇ６の範囲に下記の元データ例を入力し、下記に説明している関数式をＧ１－Ｍ１列に実際に入力して、式を下方向に複写して、シートに現れる結果を見て考えてください＞
ーー
（セルのデータA2:F7） ＜－Ａ２スタートに注意
商品１ a b c
商品２ d e
商品３ f g h
商品４ i j
商品５ k l m n
Ｇ列＜－下記関数式の結果
0
3
5
8
10
14
Ｉ１：Ｍ１４＜－下記関数式の結果　Ｉ，Ｊ列とＬ、Ｍ列。ＬＭ列が最終結果
1 1 商品１ a
1 2 商品１ b
1 3 商品１ c
2 1 商品２ d
2 2 商品２ e
3 1 商品３ f
3 2 商品３ g
3 3 商品３ h
4 1 商品４ i
4 2 商品４ j
5 1 商品５ k
5 2 商品５ l
5 3 商品５ m
5 4 商品５ n
式を入れる行は第１行目がスタートです。
ーー
（セルの式） セル 式 内容・目的
G１ =COUNT($B1:F$1) その行までのデータ個数の累積数

I１ =MATCH(ROW()-1,$G$1:$G$10,1) 何行目を見るか

Ｊ１ =ROW()-INDEX($G$1:$G$10,I1) 何列目を見るか

L１ =INDEX($A$2:$A$100,I1) 商品名の最終結果を出す式

M１ =INDEX($B$2:$F$10,I1,K1) （オプション情報の）最終結果を出す式

それぞれの列で下方向に式を複写
最終結果はＬ，Ｍ列に出る。
ーーー
理解しやすいように、Ｉ，Ｊ列は、独立して結果の値を見せている。
意味が分かったら
Ｌ，Ｍの式で出てくる第１行目のＩ１，Ｊ１はＩ列やＪ列の第１行目の式を，それぞれの式の引数部分で置き換えて（組み込んで）ください 。
すると、その後Ｉ，Ｊ列は省いても良い。
しかしこの方法ではＧ列は省けない。 ＜－－欠点
ーー
関数式で
本番では、この例ではＦ列までとしているが、１４列以上にを広げる
本番では、この例では１０行までとしているだ、適当な行数にを広げる
（上記回答では、例を挙げて説明する簡略さのために、Ｆ列までかつ１０行の例を挙げた）

お礼

ありがとうございます。

丁寧にご説明いただいたので、理解する事ができました。
index関数は余り良く理解しないまま参照範囲を求めるのに使おうとして挫折した事があります。
このように指定すれば良かったのですね。

回答No.4

msMike

添付図参照
Sheet2!A2: =OFFSET(Sheet1!$A$2,(ROW(A1)-1)/7,COLUMN(A1)-1)
Sheet2!B2: =OFFSET(Sheet1!$A$2,(ROW(B1)-1)/7,COLUMN(B1)-1+MOD(ROW(B1)-1,7))
Sheet2!A2:B2 を下方にズズーッと(列Ａに数値の 0 が現れるまで)ドラッグ＆ペースト
以下は Sheet2 における操作です。
１．列Ａ、Ｂを選択して、[コピー]→[値の貼り付け]を実行
２．[ジャンプ]→[セル選択]を実行
３．“定数”に目玉入れ
４．“数値”以外に付いているチェックを外す
５．[OK]をクリック
６．[編集]→[削除]を実行
７．“行全体”に目玉を入れて、Enterキーを「エイヤッ！」と叩き付け

お礼

ありがとうございます。

offset関数は何となく使わずに来たのですが、こういう使い方ができるのですね。
ひとつ勉強になりました。

回答No.2

keithin

縦横総当たりで巡回する、一番基本形なマクロの例です。
例えばじゃなく実際のデータの入り具合によっては、より高速化する事も可能かもしれません。

sub macro1()
　dim r as long
　dim c as long
　dim w as worksheet
　set w = activesheet
　worksheets.add after:=w
　range("A1:B1") = array("商品名","オプション")

　for r = 2 to w.range("A65536").end(xlup).row
　　for c = 2 to 15
　　　if w.cells(r, c) <> "" then
　　　　with range("A65536").end(xlup).offset(1)
　　　　　.value = w.cells(r, "A").value
　　　　　.offset(0, 1).value = w.cells(r, c).value
　　　　end with
　　　end if
　　next c
　next r
end sub

お礼

ありがとうございます。

こちらの望む通りの結果が出力されたようです。
かなり高速でした。

回答No.1

eden3616

出力先の指定がないので、元データを全て削除した後に同じシートのA1セルに出力しています。
VBAコードの扱いはしたことあるとの事ですので、コードの貼付方の説明は省かせて頂きます。
最下のVBAコードよりsampleマクロを実行してください。

■VBAコード
Sub sample()
Dim myDat As Variant
Dim outDat() As String
Dim i As Long, j As Integer
Dim cnt As Long
myDat = Range(Cells(1, 1), Cells(Cells(Rows.Count, "A").End(xlUp).Row, "O"))
ReDim outDat(UBound(myDat, 1) * 14, 1)
For i = 2 To UBound(myDat, 1)
　　For j = 2 To 15
　　　　If myDat(i, j) = "" Then Exit For
　　　　outDat(cnt, 0) = myDat(i, 1)
　　　　outDat(cnt, 1) = myDat(i, j)
　　　　cnt = cnt + 1
　　Next j
Next i

Cells.ClearContents
Cells(1, 1).Resize(cnt, 2) = outDat
End Sub

お礼

ありがとうございます。

書いていただいたコードを回して見たところ、こちらの望んでいた通りの出力ができました。