VBA
Objeto Scripting.Dictionary

Observaciones

Propiedades y metodos

Un objeto del Diccionario de Scripting almacena información en pares de Clave / Elemento. Las Claves deben ser únicas y no una matriz, pero los Elementos asociados se pueden repetir (su singularidad se mantiene en la Clave complementaria) y puede ser de cualquier tipo de variante u objeto.

Un diccionario puede considerarse como una base de datos de dos campos en la memoria con un índice único primario en el primer "campo" (la clave ). Este índice único en la propiedad Claves permite "búsquedas" muy rápidas para recuperar el valor del elemento asociado de una Clave.

Propiedades

Métodos

Código de muestra

'Populate, enumerate, locate and remove entries in a dictionary that was created
'with late binding
Sub iterateDictionaryLate()
    Dim k As Variant, dict As Object
    
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare          'non-case sensitive compare model
    
    'populate the dictionary
    dict.Add Key:="Red", Item:="Balloon"
    dict.Add Key:="Green", Item:="Balloon"
    dict.Add Key:="Blue", Item:="Balloon"
    
    'iterate through the keys
    For Each k In dict.Keys
        Debug.Print k & " - " & dict.Item(k)
    Next k

    'locate the Item for Green
    Debug.Print dict.Item("Green")
    
    'remove key/item pairs from the dictionary
    dict.Remove "blue"      'remove individual key/item pair by key
    dict.RemoveAll          'remove all remaining key/item pairs

End Sub

'Populate, enumerate, locate and remove entries in a dictionary that was created
'with early binding (see Remarks)
Sub iterateDictionaryEarly()
    Dim d As Long, k As Variant
    Dim dict As New Scripting.Dictionary
    
    dict.CompareMode = vbTextCompare          'non-case sensitive compare model
    
    'populate the dictionary
    dict.Add Key:="Red", Item:="Balloon"
    dict.Add Key:="Green", Item:="Balloon"
    dict.Add Key:="Blue", Item:="Balloon"
    dict.Add Key:="White", Item:="Balloon"
    
    'iterate through the keys
    For Each k In dict.Keys
        Debug.Print k & " - " & dict.Item(k)
    Next k

    'iterate through the keys by the count
    For d = 0 To dict.Count - 1
        Debug.Print dict.Keys(d) & " - " & dict.Items(d)
    Next d
    
    'iterate through the keys by the boundaries of the keys collection
    For d = LBound(dict.Keys) To UBound(dict.Keys)
        Debug.Print dict.Keys(d) & " - " & dict.Items(d)
    Next d
    
    'locate the Item for Green
    Debug.Print dict.Item("Green")
    'locate the Item for the first key
    Debug.Print dict.Item(dict.Keys(0))
    'locate the Item for the last key
    Debug.Print dict.Item(dict.Keys(UBound(dict.Keys)))
    
    'remove key/item pairs from the dictionary
    dict.Remove "blue"                         'remove individual key/item pair by key
    dict.Remove dict.Keys(0)                   'remove first key/item by index position
    dict.Remove dict.Keys(UBound(dict.Keys))   'remove last key/item by index position
    dict.RemoveAll                             'remove all remaining key/item pairs

End Sub

Agregando datos con Scripting.Dictionary (Maximum, Count)

Los diccionarios son excelentes para administrar información donde se producen entradas múltiples, pero solo le preocupa un valor único para cada conjunto de entradas: el primer o último valor, el mínimo o el valor máximo, un promedio, una suma, etc.

Considere un libro de trabajo que contenga un registro de la actividad del usuario, con un script que inserte el nombre de usuario y la fecha de edición cada vez que alguien edite el libro de trabajo:

Hoja de Log

UNA	segundo
mover	12/12/2016 9:00
Alicia	13/10/2016 13:00
mover	13/10/2016 13:30
Alicia	13/10/2016 14:00
Alicia	14/10/2016 13:00

Supongamos que desea generar la última hora de edición para cada usuario en una hoja de cálculo llamada Summary .

<sup>Notas:
1. Se asume que los datos están en ActiveWorkbook .
2. Estamos utilizando una matriz para extraer los valores de la hoja de trabajo; esto es más eficiente que iterar sobre cada celda.
3. El Dictionary se crea mediante el enlace temprano.</sup>

Sub LastEdit()
Dim vLog as Variant, vKey as Variant
Dim dict as New Scripting.Dictionary
Dim lastRow As Integer, lastColumn As Integer
Dim i as Long
Dim anchor As Range

With ActiveWorkbook
    With .Sheets("Log")
        'Pull entries in "log" into a variant array
        lastRow = .Range("a" & .Rows.Count).End(xlUp).Row
        vlog = .Range("a1", .Cells(lastRow, 2)).Value2

        'Loop through array
        For i = 1 to lastRow
            Dim username As String
            username = vlog(i, 1)
            Dim editDate As Date
            editDate = vlog(i, 2)

            'If the username is not yet in the dictionary:
            If Not dict.Exists(username) Then
                dict(username) = editDate
            ElseIf dict(username) < editDate Then
                dict(username) = editDate
            End If
        Next
    End With

    With .Sheets("Summary")
        'Loop through keys
        For Each vKey in dict.Keys
            'Add the key and value at the next available row
            Anchor = .Range("A" & .Rows.Count).End(xlUp).Offset(1,0)
            Anchor = vKey
            Anchor.Offset(0,1) = dict(vKey)
        Next vKey
    End With
End With
End Sub

y la salida se verá así:

Hoja de trabajo de Summary

UNA	segundo
mover	13/10/2016 13:30
Alicia	14/10/2016 13:00

Si, por otro lado, desea mostrar cuántas veces ha editado el libro cada usuario, el cuerpo del bucle For debe tener este aspecto:

        'Loop through array
        For i = 1 to lastRow
            Dim username As String
            username = vlog(i, 1)

            'If the username is not yet in the dictionary:
            If Not dict.Exists(username) Then
                dict(username) = 1
            Else
                dict(username) = dict(username) + 1
            End If
        Next

y la salida se verá así:

Hoja de trabajo de Summary

UNA	segundo
mover	2
Alicia	3

Obteniendo valores únicos con Scripting.Dictionary

El Dictionary permite obtener un conjunto único de valores muy simple. Considera la siguiente función:

Function Unique(values As Variant) As Variant()
    'Put all the values as keys into a dictionary
    Dim dict As New Scripting.Dictionary
    Dim val As Variant
    For Each val In values
        dict(val) = 1 'The value doesn't matter here
    Next
    Unique = dict.Keys
End Function

que entonces podrías llamar así:

Dim duplicates() As Variant
duplicates = Array(1, 2, 3, 1, 2, 3)
Dim uniqueVals() As Variant
uniqueVals = Unique(duplicates)

y uniqueVals contendría solo {1,2,3} .

Nota: esta función se puede utilizar con cualquier objeto enumerable.