VBA
Objet Scripting.Dictionary

Remarques

Propriétés et méthodes

Un objet Scripting Dictionary stocke des informations dans des paires Key / Item. Les clés doivent être uniques et non un tableau, mais les éléments associés peuvent être répétés (leur caractère unique est détenu par la clé associée) et peuvent être de n'importe quel type de variante ou d'objet.

Un dictionnaire peut être considéré comme une base de données en mémoire à deux champs avec un index unique primaire sur le premier «champ» (la clé ). Cet index unique sur la propriété Keys permet des recherches très rapides pour récupérer la valeur d'un élément associé à une clé.

Propriétés

Les méthodes

Exemple de code

'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

Agrégation des données avec Scripting.Dictionary (Maximum, Count)

Les dictionnaires sont parfaits pour gérer les informations lorsque plusieurs entrées se produisent, mais vous ne vous préoccupez que d'une seule valeur pour chaque ensemble d'entrées - la première ou la dernière valeur, la valeur minimale ou maximale, une moyenne, une somme, etc.

Considérez un classeur contenant un journal d'activité de l'utilisateur, avec un script qui insère le nom d'utilisateur et la date de modification chaque fois que quelqu'un modifie le classeur:

Log travail de Log

UNE	B
bob	10/12/2016 9:00
Alice	10/13/2016 13:00
bob	10/13/2016 13:30
Alice	10/13/2016 14:00
Alice	10/14/2016 13:00

Supposons que vous souhaitiez afficher la dernière heure de modification pour chaque utilisateur dans une feuille de calcul appelée Summary .

<sup>Remarques:
1. Les données sont supposées être dans ActiveWorkbook .
2. Nous utilisons un tableau pour extraire les valeurs de la feuille de calcul; c'est plus efficace que l'itération sur chaque cellule.
3. Le Dictionary est créé en utilisant la liaison anticipée.</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

et la sortie ressemblera à ceci:

Summary travail Summary

UNE	B
bob	10/13/2016 13:30
Alice	10/14/2016 13:00

Si, d'autre part, vous souhaitez afficher le nombre de fois que chaque utilisateur a modifié le classeur, le corps de la boucle For doit ressembler à ceci:

        '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

et la sortie ressemblera à ceci:

Summary travail Summary

UNE	B
bob	2
Alice	3

Obtenir des valeurs uniques avec Scripting.Dictionary

Le Dictionary permet d'obtenir un ensemble unique de valeurs très simplement. Considérons la fonction suivante:

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 vous pourriez alors appeler comme ceci:

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

et uniqueVals ne contiendrait que {1,2,3} .

Remarque: Cette fonction peut être utilisée avec n'importe quel objet énumérable.