martes, 27 de septiembre de 2016

VBA: Objeto Dictionary - Resaltar Palabras elegidas dentro de un Rango.

Aprovecharé hoy para emplear el objeto Dictionary, similar a una Collection en cuanto a finalidad o propósito... pero que aporta algún matiz.

Sirva como breve referencia lo siguiente.
1- La opción para especificar un método de comparación para las claves (vbBinaryCompare y vbTextCompare). Esto permitiría distinguir clave entre mayúsculas y minúsculas.
2- Un método (.Exists) para determinar si existe un objeto en un diccionario.
3- Un método (.Keys) para extraer todas las claves en una matriz.
4- Un método (.Items)para la extracción de todos los elementos en una matriz.
5- Un método (.Key(xxx)=yyyy)para cambiar un valor de clave.
6- Un método (.RemoveAll) para quitar todos los elementos del diccionario.

Una diferencia importante entre el objeto de Collection y el objeto Dictionary es el comportamiento de la propiedad Item: Si utilizamos la propiedad Item para hacer referencia a una clave inexistente de una Collection, obtendremos un error, en cambio si utiliza la propiedad Item para hacer referencia a una clave no existente en un dictionary, dicha clave se agregará al diccionario!! (Por ello, deberemos emplear el método .Exists para determinar si es o no una clave en un Dictionary.)


Comenzamos el ejemplo asignando un Nombre definido al rango A2:A6
contenido =Listado!$A$2:$A$6
este rango contiene una serie de palabras que son importantes y queremos resaltar dentro del texto que aparezca en otro rango...

VBA: Objeto Dictionary - Resaltar Palabras elegidas dentro de un Rango.



Insertamos el siguiente procedimiento en un módulo estándar de nuestro proyecto de VB, y posteriormente asignamos la macro a un botón:

Sub MarcarPalabras()
Dim Rng As Range, Dn As Range
Dim Sp As Variant    'Array
Dim pos As Long, n As Long, x As Long
Dim Dic As Object   'objeto Dictionary

'recuperamos el rango a partir del nombre definido creado
Set Rng = ActiveWorkbook.Names("contenido").RefersToRange

'Generamos nuestro propio objeto Dictionary
Set Dic = CreateObject("scripting.dictionary")
'definimos el tipo/propiedad del objeto
'vbBinaryCompare = si necesitamos una comparativa, respecto a mayusculas-minúsculas, exacta
'vbTextCompare = si NO necesitamos una comparativa, respecto a mayusculas-minúsculas, exacta
Dic.CompareMode = vbTextCompare

'recorremos cada celda del rango, i.e., cada palabra a localizar
'añadiendola a nuestro dictionary
x = 1
For Each Dn In Rng
    'si no existe la nueva palabra la añadimos al Diccionario
    'método .Exists
    If Not Dic.Exists(Dn.Value) Then
        'método Add
        Dic.Add Dn.Value, x
        x = x + 1
    End If
Next Dn

'con el diccionario creado, recorremos cada celda del rango seleccionado
'y cada palabra de cada celda
For Each celda In Selection
    c = 0:    pos = 0
    'separamos las frases por palabras
    Sp = Split(celda.Value, " ")
        'y recorremos cada palabra
        For n = 1 To UBound(Sp)
            'si existe la palabra..
            If Dic.Exists(Sp(n)) Then
                '...localizamos su posición y longitud
                pos = InStr(pos + 1, celda.Value, Sp(n), vbTextCompare)
                'para marcarla en rojo
                celda.Characters(pos, Len(Sp(n))).Font.Color = vbRed
            End If
        Next n
Next celda
End Sub



Tras ejecutar nuestra macro este es el resultado, tal como esperábamos:

VBA: Objeto Dictionary - Resaltar Palabras elegidas dentro de un Rango.

8 comentarios:

  1. Hola Ismael

    Quisiera hacerte una pregunta, que tal vez no tenga relación con este post, me gustaría guardar el valor actual de la celda para luego compararlo con la misma celda, y resaltar si el valor cambió, son valores númericos y me gustaría identificar si alguno cambió.

    Te agradezco mucho tu amable respuesta
    Saludos,

    ResponderEliminar
    Respuestas
    1. Hola Elly,
      puedes saber fácilmente si se ha editado la celda añadiendo esta rutina en la ventana de código de la hoja:
      Sub Worksheet_Change(ByVal Target As Range)
      If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
      MsgBox "celda modificada"
      End If
      End Sub


      Pero verificar si además de editarse tiene un valor distinto es algo más elaborado y complejo...

      Subiré una explicación en breve.

      Saludos

      Eliminar
  2. Ismael Romero:
    Un par de pequeñas observaciones:
    1) Al agregar las claves al diccionario se crea un array con base CERO, independientemente del valor de Option Base. Razón por la cual el valor inicial de la variable n, no puede ser uno (n=1), el problema se corrige si inicializamos la variable en CERO (n=0).
    2) El rango definido al que hemos nombrado “Contenido”, en realidad es un rango discontinuo que debe incluir las celdas, (A2:A6 ; C4; C6 ), de otra manera no formarán parte de la selección ( Rng.Select. ), así mismo la búsqueda de claves en estos textos.
    Un saludo cordial y un agradecimiento por este excelente ejemplo.

    ResponderEliminar
    Respuestas
    1. Muchas gracias por tus comentarios Mario, siempre se agradecen visiones distintas sobre lo expuesto...
      pero habrás comprobado que sin necesidad de definir/forzar Option Base 1 elk código corre y funciona recorriendo todos los elementos del Dictionary (desde la primera palabra 'excel' hasta la última);-)
      Y en cuanto al segundo punto, la definicón es correcta como está, ya que el rango que contiene las palabras a localizar es únicamente A2:A6, siendo C4 y C6 el rango donde localizar dichas palabras.. y no deben (en A2:A6) formar parte del rango donde buscarse a si mismas..

      ;-)

      Un cordial saludo y de nuevo gracias por compartir!!

      Eliminar
  3. Hola Ismael

    Espero que siga vigente este Post, tengo una hoja con una tabla con N° registros. Lo que intento hacer es acumular un valor cuando se cumpla una condición... ejemplo( columna A = Argentina, columna B = Brasil, columna C = 100...) if A = B then total = C + C , no se si se entendio.. como es un listado muy extenso y para recorrerlo una sola vez pensé en una macro con una estructura de diccionario... Desde ya muchas gracias

    ResponderEliminar
    Respuestas
    1. Hola Juan,
      entiendo que en la col A y col B tienes diferentes países , y en la col C importes, y quieres ir acumulando los importes de C correspondientes cuando AyB sean iguales...
      Si es así una sencilla fórmula te dará loq ue quieres:
      =SUMA(SI(A2:A100=B2:B100;C2:C100))
      pero validando con Ctrl+Mayusc+Enter en vez de solo Enter
      Saludos

      Eliminar
    2. hola ismael gracias por tu resouesta, lo q me falto aclarar es que lo tengo q hacer para 50 paises... de programacion se poco, casi siempre guardo los datos e nu varu}ialbe y recorro el arcchivo con un for o un while... pero esta al ser 50 paises, por eso pense en un array. para recorrerlo solo una vez y gradar los datods de los 50 paises...gracias

      Eliminar
    3. Hola Juan,
      creo que con programación o sin programación tendrás que evaluar cada caso (para esos 50 países), así que, la función comentada y ampliada diría te sigue sirviendo:
      =SUMA(SI(A2:A100="País 1";SI(A2:A100=B2:B100;C2:C100))

      Con progamación tendrías que anidar dentro de tus con unos IF THEN ELSE ... las mismas condiciones...

      Saludos

      Eliminar