☰

Dividir o texto nas células em linhas separadas

tag-icon • tag-icon macos microsoft-excel vba
Dividir o texto nas células em linhas separadas

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

Link da pergunta original: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

Como posso alterar este código se eu tiver mais colunas que precisam ser classificadas da mesma forma que este código classifica os dados atualmente. Porque no momento ele processa apenas 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.

Responder1

Você altera esta parte 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ê compensa pornondenpode ser positivo ou negativo (direita/esquerda ou baixo/cima) colocando-o na offset()função.

informação relacionada