Dividir texto en celdas en filas separadas

Dividir texto en celdas en filas separadas

Me encontré con este código hace un tiempo, funciona perfectamente, pero me gustaría hacerle algunas modificaciones para reflejar lo que quiero. He estado jugando con este código por un tiempo y hasta ahora no he podido solucionarlo por mi cuenta y necesito ayuda.

Enlace de pregunta 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

¿Cómo puedo cambiar este código? Si tengo más columnas que deben ordenarse de la misma manera que este código ordena los datos actualmente. Porque por el momento solo procesa 3 columnas a la izquierda y a la derecha de la columna 'B'.

No sé si estoy siendo vago o no, pero realmente no sé cómo explicar mi problema. Cualquier ayuda será apreciada.

Respuesta1

Cambias esta parte del 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 las columnas adicionales -

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)

O, en otras palabras, se compensa connortedóndenortepuede ser positivo o negativo (derecha/izquierda o abajo/arriba) poniéndolo en la offset()función.

información relacionada