martes, 5 de abril de 2011

VBA: función personalizada SUSTITUIR.

Una amiga del blog realizó una consulta curiosa hace unos días:

...Tengo cadenas alfanuméricas en una celda como esta:

"GEAGUATEMALA54132169" <54132169>

Con todo y las comillas dobles, necesito extraer solo la parte del texto sin las comillas, el texto no tiene en todas las filas el mismo número de caractéres y no encuentro la forma de lograrlo...


Lo primero que me vino a la mente fue, dada la poca homogeneidad entre los diferentes datos a tratar, usar la herramienta reemplazar(Ctrl+l) tantas veces como fuera necesario hasta dejar sólo los caracteres alfabéticos, esto es, reemplazar los dígitos de 0 a 9, comillas y los símbolos < y > para todo el rango de datos.
Como suponía esta tarea se repetiría con cierta periodicidad abandoné esta primera idea y quise automatizarla mediante una función
=SUSTITUIR(texto; texto original; texto nuevo)
con el inconveniente de tener que anidar demasiadas veces (hasta 13!!) una función SUSTITUIR en otra... sólo quedaba, entonces, una última posibilidad: desarrollar una función personalizada ó 'User Defined Function' (UDF).
Para explicar este pequeño desarrollo adelantaré que es necesario conocer el conjunto de caracteres ANSI, conjunto de 255 caracteres que representan todos y cada uno de los símbolos con los que podemos trabajar. Podemos obtener la equivalencia completa con la funciín de Excel =CARACTER(valor).
De igual forma, convendría recordar que es una matriz ó Array.


Incluiremos este código dentro de un módulo del Explorador de proyectos (dentro del Editor de VBA ):

Function sacar(texto)
Dim primero, ultimo As Variant
ScreenUpdating = False
'se definen los códigos de los caracteres a emplear con una matriz -  ARRAY.
'son los códigos correspondientes a los caracteres a reemplazar.
matriz = Array(34, 60, 62, 32, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57)
primero = LBound(matriz)
ultimo = UBound(matriz)
'con este bucle pasamos por cada uno de los códigos
For i = primero To ultimo
'llamamos a la función SUSTITUIR, para que reemplace cada caracter por 'nada' (vacio)
texto = Application.WorksheetFunction.Substitute(texto, Chr(matriz(i)), "")
Next
ScreenUpdating = True
sacar = texto

End Function



Ya podemos probar nuestra función sacar sobre las celdas a tratar...

4 comentarios:

  1. Que tal :

    Public Function SacarCharsDe(strText As String, ListaChars As String) As String
    SacarCharsDe = ""
    For n = 1 To Len(strText)
    SacarCharsDe = SacarCharsDe & IIf(InStr(ListaChars, Mid(strText, n, 1)) > 0, "", Mid(strText, n, 1))
    Next
    End Function
    ==============================================
    Por ejemplo :
    b3="00qwerty123qwerty124"
    b5="02468"
    b6="13579"
    c3= SacarCharsDe(B3;CONCATENAR(B5;B6))

    ResponderEliminar
  2. Muchas gracias por el aporte cllach!!!
    una forma muy buena de definir fuera de la macro (en la hoja de cálculo) los caracteres a 'eliminar'.
    Un saludo!!

    ResponderEliminar
  3. Hola que tal espero estén bien, necesito su ayuda, pues requiero una macro para evaluar en grandes y muy dinámicos listados todos los caracteres especiales que se puedan presentar, para remplazarlos por los caracteres que correspondan, (ej.:Á --> Á y así), estuve revisando por Internet y no consigo nada tan dinámico y variable pues todos definen cada variable y serian muchísimas.... de antemano muchas gracias por la ayuda que me puedan brindar...

    ResponderEliminar
    Respuestas
    1. Hola Irvic,
      la macro no diferiría mucho del proceso manual..
      Necesitarías una tabla de equivalencias para luego recorrerla con algún tipo de loop (por ejemplo, for each.. next) que realice el reemplazamiento (empleando Replace).
      Espero haberte orientado.
      Saludos

      Eliminar