EXTRAER DATOS DE UNA CADENA DE TEXTO DE DOS EN DOS O MÁS CARACTERES

Hola a todos:

Hace unos días me llegó una consulta donde solicitaban extraer información de una cadena de datos. Sobre esta temática hay varios post dedicados en la web 🙂

Aquí lo que me pedían era el modo de extraer datos de dos en dos y pasarlos a columnas contiguas. Es un trabajo sencillo pero requiere modificar la macro desarrollada en este post: EXTRAER INFORMACIÓN ESPECÍFICA DE UNA CADENA ALFANUMÉRICA UTILIZANDO TEXTO EN COLUMNAS

Realmente lo que vamos a necesitar es fragmentar esa cadena de datos de dos en dos y con un espacio entre cada par de números, para luego utilizar texto en columnas y separar por espacios.

Pues bien, vamos a utilizar este ejemplo:

en este caso trabajamos con datos numéricos y formato numérico, pero funciona perfectamente para texto. Y utilizaremos la siguiente macro:

Sub Extrae_n_caracteres()
'Definimos variables
Dim i As Integer, j As Integer, n As Integer, fin As Integer
Dim nCampos As Integer, n_Colum As Integer
Dim miCelda As String, sCadena As String, nPar As String
Dim miArray As Variant, iArray As Variant
'Iniciamos la macro
With Sheets("DATOS")
Application.ScreenUpdating = False
fin = Application.CountA(.Range("A:A"))
'Borramos información a partir de la columna "B"
.Range(.Cells(2, 2), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
'Iniciamos bucle para recorrar todas las filas
For j = 2 To fin
sCadena = vbNullString
miCelda = .Cells(j, 1)
'Vaciamos variable scadena
For i = 1 To Len(miCelda) Step 2
'Extraemos de 2 en 2
nPar = Mid(miCelda, i, 2)
'Añadimos un espacio cada dos números
sCadena = sCadena & " " & nPar
Next
'Eliminamos espacios al principio y final
miCelda = Trim(sCadena)
'Pasamos la cadena a la segunda columna
.Cells(j, 2) = Trim(sCadena)
'Dimensionamos matrices con los datos que tenemos en miCelda
'para determinar las columnas de la función textToColumns
nCampos = Len(.Cells(j, 2))
nCampos = nCampos - 1
ReDim miArray(0 To nCampos)
For n_Colum = 0 To nCampos
ReDim iArray(0 To 1)
iArray(0) = n_Colum + 1
iArray(1) = 2
miArray(n_Colum) = iArray
Next n_Colum
'Aplicamos la función texto en columnas a partir de la segunda columna
'delimitamos el texto en caracteres (en este ejemplo utilizamos los espacios).
Cells(j, 2).TextToColumns Destination:=Range("B" & j), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True, FieldInfo:=miArray
'Indicamos que todas las matrices tengan formato general, pero podríamos indicar que sea número, etc
Next
.Cells(j, 1).Select
End With
End Sub

El resultado será el siguiente:

Podríamos modificar los parámetros para extraer de tres en tres: modificando los parámetros de la macro (en rojo)

For i = 1 To Len(miCelda) Step 3
'Extraemos de 3 en 3
nPar = Mid(miCelda, i, 3)
'Añadimos un espacio cada tres números
sCadena = sCadena & " " & nPar
Next


o de cuatro en cuatro:

For i = 1 To Len(miCelda) Step 4
'Extraemos de 4 en 4
nPar = Mid(miCelda, i, 4)
'Añadimos un espacio cada tres números
sCadena = sCadena & " " & nPar
Next


Incluso podríamos extraer cada n posiciones repitiendo el último número del fragmento anterior:

For i = 1 To Len(miCelda) Step 1
'Extraemos de 2 en 2 y añadiendo en número del fragmento anterior
nPar = Mid(miCelda, i, 2)
'Añadimos un espacio cada dos números
sCadena = sCadena & " " & nPar
Next

Y este ha sido el resultado de la consulta, que le sirvió a nuestro lector perfectamente para seguir con su proyecto 🙂

Espero que os sea de utilidad también a vosotros.

Descarga el archivo de ejemplo pulsando en: EXTRAER DATOS DE UNA CADENA DE TEXTO DE DOS EN DOS O MAS CARACTERES

 
¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.



¡¡Muchas gracias!!