エクセルVBAで以下の行列を作る方法

質問

よろしくお願いします。
以下のようなデータがある場合、目的の形を作るためのプログラムを教えて下さい。

■データ
　　　　　　A列　　　　　B列
1行目　　日本　　　　　パン、お菓子、水
2行目　　アメリカ　　　小麦、スイカ、メロン、梨

■目的の形（別シートに）
　　　　　　A列　　　　　B列
1行目　　日本　　　　　パン
2行目　　日本　　　　　お菓子
3行目　　日本　　　　　水
4行目　　アメリカ　　　小麦
5行目　　アメリカ　　　スイカ　
6行目　　アメリカ　　　メロン
7行目　　アメリカ　　　梨

簡単に書きましたが、B列に入るデータ個数は4個以内とは限りません。
また、本当はB列の区切りが改行だったり、空白だったりするのです・・。
ただし、上記の形がわかれば後は頑張ってみます。

どうぞよろしくお願いします。

回答No.4

tom04 · ベストアンサー

No.2です。

＞混在したプログラムは作れないので

とありましたので、一気にやってみました。
区切りられている文字は
読点（、）・半角スペース・全角スペース・改行　
にしています。

Sub Sample2()
Dim i As Long, j As Long, k As Long, cnt As Long
Dim wS1 As Worksheet, wS2 As Worksheet, myArray1, myArray2, tmp
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
myArray1 = Array("、", " ", "　", vbLf) '←ココに「区切り」の文字を追加する
For i = 1 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
tmp = wS1.Cells(i, 2)
For j = 0 To UBound(myArray1)
tmp = Replace(tmp, myArray1(j), ",") '←区切り文字をすべてカンマ（,）に置換
Next j
myArray2 = Split(tmp, ",")
For k = 0 To UBound(myArray2)
cnt = cnt + 1
With wS2.Cells(cnt, 1)
.Value = wS1.Cells(i, 1)
.Offset(, 1) = myArray2(k)
End With
Next k
Next i
End Sub

今度はどうでしょうか？m(_ _)m

お礼

ご連絡遅くなりました。
tom04さんありがとうございます！！！

色々思考錯誤していたのですが、
私の書いたプログラムはVBAさんに怒られまくっていたので
本当に助かりました。

他の皆様も本当にありがとうございました。
BAを選ぶというのも変な形ですが、2回記載して頂いたtom04さんをBAにさせて頂きます。

私も早く上達し、教えてあげられるように精進します。
この度は皆様ありがとうございました。

回答No.3

mindatg

>混在したプログラムは作れないので（汗）
>別々のマクロを作り、
>１つずつ実施していこうと思います。

そういうのは区切り文字全てを総当りで探し特定の区切り文字に置き換えてしまう

No2の回答の
For i = 1 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
myArray = Split(wS1.Cells(i, 2), "、")
For k = 0 To UBound(myArray)

これを、

For i = 1 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
myArray = mySplit( wS1.Cells(i, 2) )
For k = 0 To UBound(myArray)

に変更し、以下の関数を適当なとこに貼り付け

' 区切り文字総置き換え＆Split　ただしテストしてません
Function mySplit(varData As Variant) As Variant()

' 想定しうる区切り文字
hoge() = Array("、", " ", "。", vbCrLf)

Dim stTemp As String
Dim stBuff As String
Dim stDelim As String

stDelim = "＠"　' 区切り文字を全て＠に置き換える

stTemp = varData

ForEach( piyo In hoge )
{
stBuff = Replace(stTemp, piyo, stDelim)
stTemp = stBuff
}

Dim aryData() As Variant
aryData() = Split(stTemp, stDelim) ' 全て＠で分解

mySplit = aryData

End Function

データの名前に区切り文字が含まれている場合
　例）　山崎の、食パン、お菓子、スイカ メロン

このケースは非常に面倒くさいです。力技でやったほうが早いかも

お礼

mindatgさんありがとうございます！！！
@にしてしまうのは発想の転換ですね・・・・。
尊敬してしまいます。

書き方は頂いているので、
これを理解しながら自分で組み立ててみます！

プログラムをレベルアップして頂き本当にありがたいです。
本当にありがとうございます。

回答No.2

tom04

こんにちは！
一例です。
Sheet1のデータをSheet2に表示するようにしてみました。
Sheet1のB列は「、」で区切られているとします。

標準モジュールにコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim i As Long, k As Long, j As Long, cnt As Long, str As String, myArray, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
For i = 1 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
myArray = Split(wS1.Cells(i, 2), "、")
For k = 0 To UBound(myArray)
If myArray(k) <> "" Then
cnt = cnt + 1
With wS2.Cells(cnt, 1)
.Value = wS1.Cells(i, 1)
.Offset(, 1) = myArray(k)
End With
End If
Next k
Next i
End Sub

※　上記コードでは区切りを「、」（読点）としていますが、
＞本当はB列の区切りが改行だったり、空白だったりするのです・・。
とありますので

＞myArray = Split(wS1.Cells(i, 2), "、")
の部分を
空白（全角）の場合は
＞myArray = Split(wS1.Cells(i, 2), "　")

改行の場合は
＞myArray = Split(wS1.Cells(i, 2), vbLf)
のように変更してみてください。

尚、これらが混在している場合は少し厄介になると思います。

やり方としては区切られている文字を一旦何らかの文字に統一して、その文字で区切る！って感じでしょうかね？

この程度でごめんなさいね。m(_ _)m

お礼

tom04さんありがとうございます。
空白や改行の場合も困っていたので本当にありがたいです。

混在したプログラムは作れないので（汗）
別々のマクロを作り、
１つずつ実施していこうと思います。

こんなに早くありがとうございます。

回答No.1

mt2008

こんな感じでどうでしょう

Sub sample()
　　Dim nMaxRow, nWriteRow, i, j, sDataA
　　Dim sDataB
　　nMaxRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
　　For i = 1 To nMaxRow
　　　　sDataA = Sheets(1).Cells(i, 1).Value
　　　　sDataB = Split(Sheets(1).Cells(i, 2).Value, "、")
　　　　For j = 0 To UBound(sDataB)
　　　　　　nWriteRow = nWriteRow + 1
　　　　　　Sheets(2).Cells(nWriteRow, 1) = sDataA
　　　　　　Sheets(2).Cells(nWriteRow, 2) = sDataB(j)
　　　　Next j
　　Next i
End Sub

お礼

mt2008さん。早速のご返信ありがとうございます。
頂いたプログラムをもとに実行しながら勉強していきます。

しかもB列の内容が何個であっても
実行できるようにして頂き、本当にありがとうございます！