Macro que separe información dividida por carácter especifico ( / ) dentro de una misma celda y la pegue una fila abajo.

Espero no confundir con mi pregunta pero no encuentro la manera de hacer este trabajo, espero me puedan ayudar.

Tengo un Libro de Excel con mas de 10 mil filas de registros, en la columna i, en su mayoría son registros únicos como este: AEAD004A2, pero hay ocasiones que obtengo este tipo de información: " AEAD061UB / AEAD061UD / AEAD061UC ". Se necesita separar esa información en celdas diferentes (algo como texto en columnas, pero en filas), y que la pegue exactamente abajo de la fila donde la encontró y copie la información del resto de la fila de donde se separo, para este(os) nuevo(s) registro(s)., desde la columna A hasta la columna BQ. Y las demás filas, las desplace hacia abajo, la cantidad de veces que necesite.

Ejemplo 1: Registros normales.

Ejemplo 2: Registros agrupados pero divididos por "/ ".

En ocasiones solo pueden ser dos registros dentro de una misma celda, pero hay otras ocasiones que pueden ser 5 o 6, dentro de la misma celda y tendría que aplicar el mismo criterio.

Así es ahora:

Así debe de quedar:

Espero puedan ayudarme y si es necesario que les envié el archivo, para que puedan trabajar sobre el, no hay ningún problema.

2 Respuestas

Respuesta
1

Trata con esta macro

Sub separar_copiar()
Set datos = Range("a1").CurrentRegion

With datos
columna = Range("i1").Column
Set datos = .Rows(2).Resize(.Rows.Count - 1, .Columns.Count)
For i = 1 To .Rows.Count
celda = Split(.Cells(i, columna), "/")
cantidad = UBound(celda)
If UBound(celda) > 0 Then
.Cells(i + 1, columna).Resize(cantidad, .Columns.Count).EntireRow.Insert
Set region = .Rows(i).Resize(cantidad + 1, .Columns.Count)
With region
.Rows(2).Resize(cantidad).Value = .Rows(1).Value
For j = 0 To cantidad
.Cells(j + 1, columna) = celda(j)
Next j
End With
End If
Next i
End With
End Sub

Recuerda no olvidar evaluar mi respuesta

James quedo excelente!!! 

Solo un pequeño detalle del que no me percate, hasta que corrí la macro. En la columna N, esta la cantidad de registros que había en esa celda. En el ejemplo que coloque arriba, en la fila 40, hay 3 registros en una misma celda, por ende en la celda N40, el registro era: 3. 

Habrá posibilidad de que en el momento que tu macro, desplace las filas con la información des concatenada, pueda dividir esta cantidad ? Dependiendo del numero que sea. 

Algo así:

Espero no causar muchas molestias

Gracias! 

Esta macro ya tiene incluida la división entre los números desconcatenados

Sub separar_copiar()
Set datos = Range("a1").CurrentRegion

With datos
columna = Range("i1").Column: columna2 = Range("n1").Column
Set datos = .Rows(2).Resize(.Rows.Count - 1, .Columns.Count)
For i = 1 To .Rows.Count
celda = Split(.Cells(i, columna), "/")
cantidad = UBound(celda)
If UBound(celda) > 0 Then
.Cells(i + 1, columna).Resize(cantidad, .Columns.Count).EntireRow.Insert
Set region = .Rows(i).Resize(cantidad + 1, .Columns.Count)
With region
valor = Val(.Cells(1, columna2)): prorateo = valor / (cantidad + 1)
.Rows(2).Resize(cantidad).Value = .Rows(1).Value
For j = 0 To cantidad
.Cells(j + 1, columna) = celda(j)
.Cells(j + 1, columna2) = prorateo
Next j
End With
End If
Next i
End With
End Sub

Excelente James!!

Muchas gracias por tu apoyo. Corre perfecto!

Gracias!

Entonces evalúa mi respuesta

Respuesta
2

Te anexo una macro. Con la opción de conservar la hoja origen; y en una hoja destino poner la información pero separada. Cambia en la macro "Hoja3" y "Hoja4" por los nombres de tus hojas. Si por último no te sirve la hoja origen, pues simplemente la puedes eliminar.

Sub Separar_Spool()
'Por.Dante Amor
    Set h1 = Sheets("Hoja3")        'hoja origen
    Set h2 = Sheets("Hoja4")        'hoja destino
    '
    h2.Rows("2:" & Rows.Count).Clear
    j = 2
    '
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If InStr(1, h1.Cells(i, "I"), "/") > 0 Then
            datos = Split(h1.Cells(i, "I"), "/")
            For k = LBound(datos) To UBound(datos)
                h1.Rows(i).Copy h2.Rows(j)
                h2.Cells(j, "I") = WorksheetFunction.Trim(datos(k))
                j = j + 1
            Next
        Else
            h1.Rows(i).Copy h2.Rows(j)
            j = j + 1
        End If
    Next
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Dante:

Un gusto saludarte de nuevo.

Corrí tu macro y trabaja como esperaba, me muestra la informacion tal cual, pero tengo un detalle del cual no me percate, en la columna N, esta la cantidad de registros que había en esa celda. En el ejemplo que coloque arriba, en la fila 40, hay 3 registros en una misma celda, por ende en la celda N40, el registro era: 3. 

Habrá posibilidad de que en el momento que tu macro, desplace las filas con la información des concatenada, pueda dividir esta cantidad ? Dependiendo del numero que sea. 

Algo así:

Te agradezco . 

Saludos. 

Si el número siempre va a ser 1, entonces puede ser así:

Sub Separar_Spool()
'Por.Dante Amor
    Set h1 = Sheets("Hoja3")        'hoja origen
    Set h2 = Sheets("Hoja4")        'hoja destino
    '
    h2.Rows("2:" & Rows.Count).Clear
    j = 2
    '
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If InStr(1, h1.Cells(i, "I"), "/") > 0 Then
            datos = Split(h1.Cells(i, "I"), "/")
            For k = LBound(datos) To UBound(datos)
                h1.Rows(i).Copy h2.Rows(j)
                h2.Cells(j, "I") = WorksheetFunction.Trim(datos(k))
                h2.Cells(j, "N") = 1
                j = j + 1
            Next
        Else
            h1.Rows(i).Copy h2.Rows(j)
            j = j + 1
        End If
    Next
    MsgBox "Fin"
End Sub

Si no es así, entonces puede ser así:

Sub Separar_Spool()
'Por.Dante Amor
    Set h1 = Sheets("Hoja3")        'hoja origen
    Set h2 = Sheets("Hoja4")        'hoja destino
    '
    h2.Rows("2:" & Rows.Count).Clear
    j = 2
    '
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If InStr(1, h1.Cells(i, "I"), "/") > 0 Then
            datos = Split(h1.Cells(i, "I"), "/")
            For k = LBound(datos) To UBound(datos)
                h1.Rows(i).Copy h2.Rows(j)
                h2.Cells(j, "I") = WorksheetFunction.Trim(datos(k))
                h2.Cells(j, "N") = h1.cells(i, "N") / (ubound(datos) + 1)
                j = j + 1
            Next
        Else
            h1.Rows(i).Copy h2.Rows(j)
            j = j + 1
        End If
    Next
    MsgBox "Fin"
End Sub

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas