Excel、1行に入力されたデータを複数行に分ける

こんなことは可能でしょうか？

A列にid、B列に「音楽」「スポーツ」「ファッション」といった文言が１〜複数個入力されているシートがあり、
1つのidで1行、3000行以上のデータがあります。

このデータをB列に入力された文言別に行を分けたいのですがこれをエクセル上で関数やマクロを用いて一括で実行することは可能でしょうか？

例として、
A1に「1」、A2に「音楽　スポーツ」
B1に「2」、B2に「ファッション」
C1に「3」、C2に「ファッション　スポーツ」
D1に「4」、D2に「スポーツ　ファッション　音楽」
と入っているデータを

A1に「1」、A2に「音楽」
2に「1」、B2に「スポーツ」
C1に「2」、C2に「ファッション」
D1に「3」、D2に「ファッション」
E1に「3」、E2に「スポーツ」
F1に「4」、F2に「スポーツ」
G1に「4」、G2に「ファッション」
H1に「4」、H2に「音楽」
という形にしたいです。


補足情報
使用ソフトはExcell for Mac 2011です。
B列に入力されている文言は全部で13種類。
B列に複数の文言が入力されている場合は改行されています。

当方エクセルはあまり詳しくないためできる限り詳細にお教えいただけると助かります。

よろしくお願いします。

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

• 実際のデータの一部を画像で補足します

  
    補足日時：2017/12/26 09:38

No.3 回答者： tom04 回答日時： 2017/12/26 11:47

続けてお邪魔します。

質問文では
＞A1に「1」、A2に「音楽　スポーツ」
＞B1に「2」、B2に「ファッション」
＞C1に「3」、C2に「ファッション　スポーツ」
＞D1に「4」、D2に「スポーツ　ファッション　音楽」

となっていますね。
すなわち1行目がナンバーで2行目にスペースで区切られた文字列が入っている。
それを列方向に伸ばして1セルごとに表示する！
という意味にとれました。
補足の画像を拝見すると全く違いますね。
↓の画像の左側のデータを右側のように表示したい！という解釈をしました。

以下のマクロを実行してみてください。

Sub Sample2()
Dim i As Long, k As Long, myAry
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If InStr(Cells(i, "B"), vbLf) > 0 Then
myAry = Split(Cells(i, "B"), vbLf)
For k = 0 To UBound(myAry)
Cells(i, k + 2) = myAry(k)
Next k
End If
Next i
End Sub

これで画像のような感じになります。m(_ _)m

No.2 回答者： tom04 回答日時： 2017/12/25 22:23

No.1です。

Mac版のExcelですね？
当方使用のWindows版のExcelではちゃんと動きました。

Mac版は使ったコトがないので、具体的にどこがどうダメなのか判りません。

サイトで検索してみると
Windows版とMac版の互換性はあまりないみたいですね。

直接の回答でなくてごめんなさい。m(_ _)m

この回答へのお礼

Mac版です。

補足に実際のデータの一部を添付しました。

ちなみにwindowsにファイルを移してExcel2010でも試して見ましたがやはり動かなかったですね・・・

お礼日時：2017/12/26 10:14

No.1 回答者： tom04 回答日時： 2017/12/25 18:14

こんばんは！

VBAになりますが、一例です。

画面左下の操作したいシート見出し上で右クリック　→　コードの表示　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻り（VBE画面を閉じて）マクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() '//この行から//
Dim j As Long, myAry, k As Long, myStr As String
For j = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
myStr = Replace(Cells(2, j), "　", " ")
If InStr(myStr, " ") > 0 Then
myAry = Split(myStr, " ")
Columns(j + UBound(myAry)).Insert
For k = 0 To UBound(myAry)
Cells(1, j + k) = Cells(1, j)
Cells(2, j + k) = myAry(k)
Next k
End If
Next j
ActiveSheet.Columns.AutoFit
End Sub '//この行まで//

※　一旦マクロを実行すると元に戻せませんので、
別シートでマクロを試してみてください。m(_ _)m

この回答へのお礼

ご回答ありがとうございます。

丁寧にご説明いただいたのに申し訳ありませんがマクロを実行してもシートに変化がありませんでした・・・
こちらの設定などの問題かもしれないのでもう少し試してみますね。

お礼日時：2017/12/25 18:40