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
>混在したプログラムは作れないので(汗)
>別々のマクロを作り、
>1つずつ実施していこうと思います。
そういうのは区切り文字全てを総当りで探し特定の区切り文字に置き換えてしまう
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
データの名前に区切り文字が含まれている場合
例) 山崎の、食パン、お菓子、スイカ メロン
このケースは非常に面倒くさいです。力技でやったほうが早いかも
こんにちは!
一例です。
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
こんな感じでどうでしょう
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
お礼
ご連絡遅くなりました。 tom04さんありがとうございます!!! 色々思考錯誤していたのですが、 私の書いたプログラムはVBAさんに怒られまくっていたので 本当に助かりました。 他の皆様も本当にありがとうございました。 BAを選ぶというのも変な形ですが、2回記載して頂いたtom04さんをBAにさせて頂きます。 私も早く上達し、教えてあげられるように精進します。 この度は皆様ありがとうございました。