セル内のテキストを別々の行に分割する

セル内のテキストを別々の行に分割する

しばらく前にこのコードを見つけましたが、完璧に動作します。しかし、私が望むことを反映するために、いくつかの変更を加えたいと思います。しばらくの間、このコードをいじっていましたが、今のところ自分で解決することができず、助けが必要です。

元の質問のリンク:https://stackoverflow.com/questions/19815321/text-to-rows-vba-excel

Option Explicit

Sub Main()

    Columns("B:B").NumberFormat = "@"
    Dim i As Long, c As Long, r As Range, v As Variant

    For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
        v = Split(Range("B" & i), "/")
        c = c + UBound(v) + 1
    Next i

    For i = 2 To c
        Set r = Range("B" & i)
        Dim arr As Variant
        arr = Split(r, "/")
        Dim j As Long
        r = arr(0)
        For j = 1 To UBound(arr)
            Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
            r.Offset(j, 0) = arr(j)
            r.Offset(j, -1) = r.Offset(0, -1)
            r.Offset(j, 1) = r.Offset(0, 1)
        Next j
    Next i

End Sub

このコードが現在データを並べ替える方法で並べ替える必要がある列がさらにある場合、このコードを変更するにはどうすればよいですか。現時点では、列 'B' の左右の 3 列のみを処理するためです。

曖昧になっているかどうかは分かりませんが、自分の問題をどう説明すればいいのか本当に分かりません。どんな助けでもいただければ幸いです。

答え1

コードのこの部分を変更します -

r.Offset(j, 0) = arr(j)
r.Offset(j, -1) = r.Offset(0, -1)
r.Offset(j, 1) = r.Offset(0, 1)

追加の列を含めるには -

r.Offset(j, 0) = arr(j)
r.Offset(j, -1) = r.Offset(0, -1)
r.Offset(j, 1) = r.Offset(0, 1)
r.Offset(j, 2) = r.Offset(0, 2)
r.Offset(j, 3) = r.Offset(0, 3)
r.Offset(j, 4) = r.Offset(0, 4)

言い換えれば、相殺するどこ関数に入力することで、正または負(右/左または下/上)にすることができますoffset()

関連情報