Dividir texto em células em linhas separadas

Question

Eu me deparei com esse código há algum tempo, ele funciona perfeitamente, mas eu gostaria de fazer algumas modificações nele para refletir o que eu quero. Eu mexi com esse código por um tempo e até agora não consegui resolver sozinho e preciso de ajuda.

Link da pergunta original: link

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

Como posso alterar este código? Se eu tiver mais colunas que precisam ser classificadas, a maneira como esse código classifica os dados atualmente. Porque no momento ele só processa 3 colunas à esquerda e à direita da coluna 'B'.

Não sei se estou sendo vago ou não, mas realmente não sei como explicar meu problema. Toda e qualquer ajuda será apreciada.

    

Answer 1

Você altera esse trecho do código -

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

para incluir as colunas adicionais -

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)

Ou, em outras palavras, você é compensado por n onde n pode ser positivo ou negativo (direita / esquerda ou abaixo / acima) colocando-o no offset() function.