lunes, 20 de febrero de 2012

VBA: Función personalizada para agregar un caracter.

Hoy desarrollaremos una función personalizada en Excel, conocidas como UDF, que modificará ciertos registrso incluidos en celdas de nuestra hoja de cálculo, de tal forma que añadirá a los caracteres de texto de dichos códigos un nuevo caracter '0'. Veámos que pedía nuestro lector:

...Trabajo con varios libros enlazados mediante datos con valores tipo alfanumérico A001; A002; A003… B001… N999.
Cada cierto tiempo me actualizan el inventario y suelo compararlo utilizando buscarv, de esta forma encuentro los códigos cambiados, nuevos registros, bajas, etc.. El problema es que me han actualizado el inventario y como hay referencias que ya pasan de X999, han introducido un 4º dígito y lo que antes era V567 es ahora V0567.
¿Se puede sustituir en todos los registros que yo he empleado en mis libros enlazados con el inventario este código antiguo para poder emplear el nuevo?...

El objetivo es construir un procedimiento Function que evalúe caracter a caracter cada contenido de una celda, de tal manera, que si encontrara un carcter de texto (realmente uno no numérico) lo reemplace por ese mismo caracter de texto (sea cual sea) y le añada, según la peteción del lector un '0' a su derecha.
En esta ocasión he optado por una función personalizada, aunque con una mínima variación, se podría construir un procedimiento Sub, esto es, una macro.
Veamos entonces nuestro código completo, que incluiremos en un módulo del Editor de VBA:

Option Base 1
Public Function AgregaLetras(cadena As String) As String

Dim Posicion As Integer, Caracter As Variant
'definimos una matriz sin especificar elementos
Dim Matr() As Variant
'la redefinimos y le asignamos un número de elementos
'igual al número de caracteres que componen la cadena a evaluar
ReDim Preserve Matr(Len(cadena))

'recorremos cada uno de dichos caracteres
For Posicion = 1 To Len(cadena)
    Caracter = Mid$(cadena, Posicion, 1)
    'si no es numérico (es de texto) entonces agrega '0'
    'si es numérico, se deja tal cual
    If IsNumeric(Caracter) = False Then
    Matr(Posicion) = Caracter & "0"
    Else
    Matr(Posicion) = Caracter
    End If
Next Posicion
'finalmente con JOIN, la función devuelve
'un concatenado de los elementos de la matriz
AgregaLetras = Join(Matr, "")
End Function


El trabajo ha consistido en disgregar caracter a caracter cada código a evaluar, verificando si éste es numérico o no, en caso de ser texto añadíamos el caracter modificado como elemento de un Array, de igual forma que si era numérico, en cuyo caso se agregaba como elemento del Array. La función finaliza sencillamente recuperando, concatenados, todos los elementos de nuestra Array.
Podemos ver el resultado en la imagen siguiente:

VBA: Función personalizada para agregar un caracter

No hay comentarios:

Publicar un comentario

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