Macro en excel para desglosar una serie de 12 números en cada celda y ubicarlos de dos en dos.

Se requiere una macro para trabajar en el rango C2:C1384, en cada celda de este rango se encuentra una serie de 12 números por ej: C2: 02 22 30 32 33 36, se requere dejar en D2 a 02; en E2 a 22; en F2 a 30; en G2 a 33 y en H2 a 36 y luego pasa a C3, celda que contiene 08 10 22 24 30 34 y pasar a hacer lo mismo hasta C1384. ¿Es posible esto?

2 respuestas

Respuesta
2

Te anexo la macro

Sub macro12()
'Por.DAM
    Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row).TextToColumns _
    Destination:=Range("D2"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 2), Array(2, 2), Array(4, 2), Array(6, 2), Array(8, 2), Array(10, 2)), _
    TrailingMinusNumbers:=True
End Sub

Saludos.Dante Amor

Gracias Dante, pero ocurre que cuando ejecuto la macro el resultado no es el esperado, porque por ejemplo en una serie:  02 03 29 32 39 41  monta el 02 en D2, en E2 solo el 0, en F2 el 3, en G2 el 29, en H2 el 3 y en I2 monta 2 39 41 y no debería ser así según lo planteado, solo deben ser dos números por celda.

Hola Dante he recibido de Valero una alternativa modificada de la tuya, te la paso, tu solución es buena y ahora trabaja excelente porque los números yo los tengo separados por espacios, ahora la pregunta es como seria si la serie va más allá de C1384, ¿a C5000 por ejemplo?

Sub macro12()
'Por.DAM
    Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row).TextToColumns _
    Destination:=Range("D2"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 2), Array(3, 2), Array(6, 2), Array(9, 2), Array(12, 2), Array(15, 2)), _
    TrailingMinusNumbers:=True
End Sub

La macro ya funciona para la última fila con datos de la columna "C"

¡Gracias! 

Es posible que los datos no queden como texto, sino como números?

Prueba así

Sub macro12()
'Por.DAM
    Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row).TextToColumns _
    Destination:=Range("D2"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(6, 1), Array(9, 1), Array(12, 1), Array(15, 1)), _
    TrailingMinusNumbers:=True
End Sub
Respuesta
1

Esta es la macro que te permite hacer eso. He supuesto que los números tienen dos cifras y están separados por un espacio blanco.

Sub deglosar()
Dim i, j As Integer
For i = 2 To 1384
    If Len(Cells(i, 3)) >= 17 Then
        For j = 0 To 5
            Cells(i, 4 + j) = Mid(Cells(i, 3), 3 * j + 1, 2)
        Next j
    Else
        MsgBox ("Fila " & i & " defectuosa")
    End If
Next i
End Sub

Es bastante sencilla, se puede mejorar algo si es necesario. Por ejemplo es muy molesto el mensaje de error si tienes muchas filas sin rellenar y tendrás que parar el programa con Ctrl + Pausa, se podría quitar o hacer algo más sofisticado.

Que tendría que hacer si a futuro la serie no llega a 1384, sino por ejemplo 5000.

Tal como está funciona perfectamente hasta 1384.

Gracias

Como te decía era muy simple y se podían mejorar muchas cosas.

Pero fíjate en la de Dante, es fantástica, yo usaría esa sin pensarlo más, a lo mejor tienes que cambiarle algo si tenes los números separados por un espacio, esto por ejemplo

Sub macro12()
'Por.DAM
    Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row).TextToColumns _
    Destination:=Range("D2"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 2), Array(3, 2), Array(6, 2), Array(9, 2), Array(12, 2), Array(15, 2)), _
    TrailingMinusNumbers:=True
End Sub

Esta macro es un cañon comparada con la mía.

Luego te la modifico para que funcione con un número indefinido de columnas.

Debería incrementar  hasta donde sea necesario?

For i = 2 To 1384
Sub deglosar()
Dim i, j, FilaFinal As Integer
FilaFinal = Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To FilaFinal
    If Len(Cells(i, 3)) >= 17 Then
        For j = 0 To 5
            Cells(i, 4 + j) = Mid(Cells(i, 3), 3 * j + 1, 2)
        Next j
    Else
        MsgBox ("Fila " & i & " defectuosa")
    End If
Next i
End Sub

Así sirve para cualquier número de filas que estén todasd seguidas empezando por la 2.

La macro de Dante ya tenía eso previsto desde el primer momento, lo mismo da que haya 2, 1283 o 5000 filas, funciona siempre bien.

El problema con la de Dante, es que deja los resultados como texto y la tuya no.

No entiendo lo que quieres decir. En mis pruebas hay resultados para todos los gustos y a veces depende del formato que hubiera antes. Y luego está también el impertinente aviso de que un número se está escribiendo como texto.

La mía y la primera de Dante dejan siempre como texto. La segunda de Dante deja el formato que había antes. Y si era texto lo deja como texto pero quita los ceros por la izquierda. Yo le pediría a él que lo dejase a tu gusto, no sé como quieres que quede exactamente y yo pienso que es la mejor macro que se puede usar.

En la mía puedes hacer que queden como números así

Sub deglosar()
Dim i, j, FilaFinal As Integer
FilaFinal = Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To FilaFinal
    If Len(Cells(i, 3)) >= 17 Then
        For j = 0 To 5
            Cells(i, 4 + j) = Val(Mid(Cells(i, 3), 3 * j + 1, 2))
        Next j
    Else
        MsgBox ("Fila " & i & " defectuosa")
    End If
Next i
End Sub

Añade tu respuesta

Haz clic para o
El autor de la pregunta ya no la sigue por lo que es posible que no reciba tu respuesta.