por Hola a todos!, ¿qué tal estáis?, espero que muy bien.
Hace tiempo, desarrollé una macro que permitía extraer determinados caracteres de una cadena de texto y utilizar la función «texto en columna» programada en VBA para mostrar la información: EXTRAER INFORMACIÓN ESPECÍFICA DE UNA CADENA ALFANUMÉRICA UTILIZANDO TEXTO EN COLUMNAS
Pues bien, hoy me ha llegado una consulta en la que me solicitaban modificar la macro para poder extraer en una cadena de texto, de dos en dos caracteres, según un número de veces indicado en una columna.
Es decir, imaginad que tenéis en una celda esta cadena de número y letras: 57e87d54222 y en una columna se especifica el número 4, por lo que hemos de extraer de dos en dos los cuatro primeros pares, así: 57 e8 7d 54
Aunque pueda parecer algo poco común, en realidad lo es, porque muchas veces la información se almacena en un cadena (de texto o numérica, o ámbas) y luego es necesario extraerla de alguna forma.
En fin, que lo mejor es ver la macro donde explico cómo lo hago:
Option Explicit
Sub Extrae_Varios()
'Definimos variables
Dim i As Integer, j As Integer, n As Integer, fin As Integer
Dim nCampos As Integer, n_Colum As Integer, nCasos As Integer
Dim nCadena As String, sCadena 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 "C"
.Range(.Cells(2, 3), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
'Iniciamos bucle para recorrer todas las filas
For j = 2 To fin
'Seleccionamos numero de casos y cadena de texto
sCadena = .Cells(j, 2)
nCasos = .Cells(j, 1) * 2
'componemos nueva cadena de dos en dos
For i = 1 To nCasos Step 2
nCadena = nCadena & " " & Mid(sCadena, i, 2)
Next
'Eliminamos espacios en blanco al principio
.Cells(j, 3) = Trim(nCadena)
'Dimensionamos matrices con los datos que tenemos
'para determinar las columnas de la función textToColumns
nCampos = Len(.Cells(j, 3))
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) = 1
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, 3).TextToColumns Destination:=Range("C" & 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
nCadena = vbNullString
Next
.Cells(j, 1).Select
End With
End Sub
El resultado de la macro es el siguiente:
Como podéis observar, extraemos la información de dos en dos y colocamos cada par en una celda diferente. Si necesitáis incrementar a tres, cuatro, etc, solo tenéis que modificar la macro y lo tendréis resuelto.
Descarga el archivo de ejemplo pulsando en: EXTRAER INFORMACIÓN DE UNA CADENA ALFANUMÉRICA EN FUNCIÓN DE VARIOS CRITERIOS
¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.
¡¡Muchas gracias!!
