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

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...

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:

http://ift.tt/1ecue6Z

---

Ahora también Cursos de Excel y Macros en www.excelforo.com

Excel

via [EXCEL FORO: EJERCICIOS, EJEMPLOS, SOLUCIONES, DUDAS] [http://ift.tt/2d3R90M]

September 26, 2016 at 09:28PM