エクセルのマクロ、特定文字での改行について

エクセルで、同じセル内で文字列が並んでおり、セル内にカンマまたはセル内改行があった場合に、新しいセルに改行させるというマクロを作りたいです。

具体的にいうと、
セルB1に「あい、うえ、」、
B2に「お、
　　　かき、く
　　　け　　　」
とあった場合、これをマクロにかけると、

B1に「あい」、B2に「うえ」、B3に「お」、B4に「かき」、B5に「く」、B6に「け」となる感じです。

マクロを組んでもセル内での改行しかできず、文字列を別のセルに改行させることがどうしてもできません。
アドバイスよろしくお願いいたします。

No.5 回答者： ママチャリ 回答日時： 2019/01/19 08:25

ご要望の要件に対して、使えそうな命令を並べてみました。

細かな処理はしていませんが、参考になれば幸いです。
見慣れないのは、Transpose関数くらいでしょうか。これは配列の縦横を入れ替えています。

Sub sample()
Dim a As Variant
a = WorksheetFunction.Transpose(Range("B1:B2"))
a = Join(a, vbLf)
a = Replace(a, "、", vbLf)
a = Split(a, vbLf)
Range("B1").Resize(UBound(a) + 1) = WorksheetFunction.Transpose(a)
End Sub

この回答へのお礼

回答ありがとうございます！
Transpose関数というものは初めて聞きましたが、とても参考になりました！ありがとうございます。

お礼日時：2019/01/21 00:14

No.4 ベストアンサー 回答者： WindFaller 回答日時： 2019/01/18 18:26

こんばんは。

私も考えてみました。

Sub TestSepMacro()
　Dim r As Range
　Dim c As Range
　Dim i As Long
　Dim arBuf As Variant, buf As String, tBuf As Variant
　Set r = Range("B1", Cells(Rows.Count, "B").End(xlUp))
　For Each c In r
　 ' If Trim(c.Value) <> "" Then '空白以外の場合に処理する **
　　　buf = Replace(c.Value, "、", ",", , , vbTextCompare)
　　　buf = Replace(buf, vbLf, ",", , , vbBinaryCompare)
　　　If Right(buf, 1) <> "," Then
　　　　tBuf = tBuf & buf & ","
　　　Else
　　　　tBuf = tBuf & buf
　　　End If
　　　buf = ""
　　'End If '**
　Next c
　arBuf = Split(tBuf, ",")
　r.ClearContents
　For i = 1 To UBound(arBuf)
　　Cells(i, "B").Value = Trim(arBuf(i - 1))
　Next i
End Sub


'** を外すと、空白行はなくなります。
そのままですと、空白行はスキップします。

この回答へのお礼

回答ありがとうございます！
こちらのコードでちゃんと質問通りに機能しました。丁寧にありがとうございます。

お礼日時：2019/01/21 00:13

No.3 回答者： tom04 回答日時： 2019/01/18 16:30

No.2です。

細かい検証をしていませんでした。
前回のコードではセルの最後に読点「、」がない場合はお望みの表示にならないおｔ思います。

＞myStr = myStr & Replace(Replace(Cells(i, "B"), "、", "_"), vbLf, "_")
の行を

＞myStr = myStr & "_" & Replace(Replace(Cells(i, "B"), "、", "_"), vbLf, "_")

に変更してください。m(_ _)m

この回答へのお礼

ご丁寧にありがとうございます！
Replaceメソッドの使い方参考になりました！

お礼日時：2019/01/21 00:11

No.2 回答者： tom04 回答日時： 2019/01/18 16:24

こんにちは！

一例です。

Sub Sample1()
　Dim i As Long, myStr As String
　Dim myAry
　　Application.ScreenUpdating = False
　　　Range("C:C").Insert
　　　　For i = 1 To Cells(Rows.Count, "B").End(xlUp).Row
　　　　　myStr = myStr & Replace(Replace(Cells(i, "B"), "、", "_"), vbLf, "_")
　　　　Next i
　　　myAry = Split(myStr, "_")
　　　　For i = 0 To UBound(myAry)
　　　　　Cells(i + 1, "C") = myAry(i)
　　　　Next i
　　　Range("C:C").SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
　　　Range("B:B").Delete
　　Application.ScreenUpdating = True
End Sub

※　いちいち行挿入するのはやめて、
C列に一旦書き出し、B列を削除しています。m(_ _)m

No.1 回答者： 銀鱗 回答日時： 2019/01/18 13:28

特定の文字を「改行コード」に変換しているだけじゃありませんか。

その改行したい文字を「切り取り」し、
下のセルに「行を挿入」または「セルを挿入」し「下へシフト」させたのちに
挿入したセルに「貼り付け」を行いましょう。

これの繰り返しです。
（どの段階で繰り返しを終了させるかも考えておきましょう）

この回答へのお礼

回答ありがとうございます！
シフトというやり方もあるのですね！参考になりました。

お礼日時：2019/01/21 00:15