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.

4 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