jueves, 11 de noviembre de 2021

VBA: Pasar texto a matriz de celdas

Hoy aplicaremos algo de programación que nos permitirá transformar una cadena de texto, separados en distintas celdas, en una matriz, distinguiendo la parte numérica de los títulos.

VBA: Pasar texto a matriz de celdas


Este ejercicio es interesante por el tratamiento que haremos con las Arrays/Matrices...
Ya que generaremos con la función SPLIT nuevas arrays, y con ReDim conseguiremos reconstruir la array definitiva... recomponiendo la parte de textos, asociada a los títulos de la 'tabla original', e incorporando después la parte numérica de dicha tabla.

He optado por generar una UDF con los siguientes argumentos:
Function RecuperaDatoMatriz(rngDatos As Range, dato_tabla As String, Optional num_fila As Long, Optional num_col As Long)
-siendo 'rngDatos' el rango de celdas donde se encuentren las distintas celdas con las cadenas de texto/número a tratar.
-el segundo argumento 'dato_tabla' nos permitirá elegir entre recuperar un dato en particular o el conjunto de la tabla.
-los dos últimos argumentos 'num_fila' y 'num_col' identifican la posición a retornar si hubieramos elegido la opción de 'dato'.

Desde el editor de VB insertaremos un nnuevo módulo estándar donde añadiremos el siguiente procedimiento Function:
Function RecuperaDatoMatriz(rngDatos As Range, dato_tabla As String, Optional num_fila As Long, Optional num_col As Long)
'   'rngDatos' el rango de celdas donde se encuentren las distintas celdas con las cadenas de texto/número a tratar.
'   'dato_tabla' nos permitirá elegir entre recuperar un dato en particular o el conjunto de la tabla.
'   'num_fila' y 'num_col' identifican la posición a retornar si hubieramos elegido la opción de 'dato'.

'definimos las distintas arrays sobre las que trabajar
Dim arrCols() As Double
Dim arrColsFinal() As Variant
Dim arrConceptos() As Variant
Dim arrConceptoCompleto() As Variant

Dim NumFilas As Integer, NumCols As Integer

'obtenemos el número de filas del rango seleccionado
NumFilas = rngDatos.Rows.Count
Dim arrFilas() As Long
ReDim arrFilas(1 To NumFilas) As Long
For nf = 1 To NumFilas
    arrFilas(nf) = nf
Next nf
'y el número de columnas máximo entre todas las celdas seleccionadas
'En este caso empleamos el espacio en blanco para separar columnas
'(idealmente incluiríamos este separador como argumento de la UDF)
For Each co In rngDatos
    arrDividido = Split(co.Value, " ", -1, vbTextCompare)
    NumCols = Application.Max(UBound(arrDividido), NumCols)
Next co

'Procedemos a obtener las matrices para la parte numérica 'arrCols' y la parte de encabezados 'arrConceptos'
'partimos las cadenas de texto con la función SPLIT, usando el espacio en blanco como separador...
f = 0
For Each celda In rngDatos
    arrDividido = Split(celda.Value, " ", -1, vbTextCompare)
    'redefinimos las dimensiones de nuestras arrays destino
    ReDim Preserve arrCols(0 To NumCols, 0 To NumFilas - 1) As Double
    ReDim Preserve arrConceptos(0 To NumCols, 0 To NumFilas - 1) As Variant
    
    c = 1: con = 1
    For itm = 0 To NumCols
        On Error Resume Next
        'recupera los números solamente
        If IsNumeric(arrDividido(itm)) Then
            arrCols(c, f) = arrDividido(itm)
            c = c + 1
        Else
            'recupera solo los textos
            arrConceptos(con, f) = arrDividido(itm)
            
            'Unimos los conceptos en un solo dato
            ReDim Preserve arrConceptoCompleto(0 To f) As Variant
            If arrConceptos(con, f) <> "" Then
                arrConceptoCompleto(f) = arrConceptoCompleto(f) & " " & VBA.Trim(arrConceptos(con, f) & " ")
            End If
            con = con + 1
        End If
        On Error GoTo 0
    Next itm
    f = f + 1
Next celda

'Recomponemos en una única array a partir de las matrices anteriores
'empezamos añadiendo en una nueva matriz, la final -arrColsFinal, la parte de los conceptos/títulos
ReDim arrColsFinal(1 To NumFilas, 1 To 1) As Variant
For xx = 1 To NumFilas
    arrColsFinal(xx, 1) = arrConceptoCompleto(xx - 1)
Next xx

'para luego ir incorporando las columnas NO vacías de números...
finC = 2
For x = 1 To NumCols + 1
    a_sp = Application.Index(Application.Transpose(arrCols), [arrFilas], [x])
    If Application.Sum(a_sp) > 0 Then
        ReDim Preserve arrColsFinal(1 To NumFilas, 1 To finC) As Variant

        For ff = 1 To NumFilas
            arrColsFinal(ff, finC) = Application.Index(Application.Transpose(arrCols), ff, x)
        Next ff

        finC = finC + 1
    End If
Next x

'Controlamos el dato o matriz devuelto según la elección del usuario
If LCase(dato_tabla) = "dato" And (Not IsMissing(num_fila) And Not IsMissing(num_col)) Then
    RecuperaDatoMatriz = Application.Index(arrColsFinal, num_fila, num_col)
ElseIf LCase(dato_tabla) = "tabla" Then
    RecuperaDatoMatriz = arrColsFinal
Else
    RecuperaDatoMatriz = "revisa los argumentos"
End If
End Function


Podemos probar nuestra UDF para recuperar una matriz a partir del conjunto de celdas como la que se ve en la imagen (que en este caso se ha recuperado desde un pdf, y correspondía a una tabla dentro de este pdf).
Añadimos nuestra función en la celda C2:
=RecuperaDatoMatriz($A$2:$A$10;"tabla")
VBA: Pasar texto a matriz de celdas


O si queremos recuperar un dato concreto correspondiente a un mes y un país...
En D13 añadimos una fórmula para identificar la fila del país:
=SUMA((ESNUMERO(ENCONTRAR(D12;$C$2:$C$10))*FILA($C$2:$C$10)))-FILA($C$2)+1
Para a continuación en D14 y siguientes añadir nuestra UDF:
=RecuperaDatoMatriz($A$2:$A$10;"dato";$D$13;COINCIDIR($C14;$C$14:$C$26;0)+1)
VBA: Pasar texto a matriz de celdas


MUY IMPORTANTE que los datos distribuidos, de la tabla original, responde a un patrón (normal si la fuente es una tabla) en cuanto a número de columnas y filas....

No hay comentarios:

Publicar un comentario

Nota: solo los miembros de este blog pueden publicar comentarios.