VBA
Objet Scripting.Dictionary
Recherche…
Remarques
Vous devez ajouter Microsoft Scripting Runtime au projet VBA via la commande Outils → Références de VBE afin de mettre en œuvre une liaison anticipée de l'objet Scripting Dictionary. Cette référence de bibliothèque est portée avec le projet; il n'est pas nécessaire de le référencer à nouveau lorsque le projet VBA est distribué et exécuté sur un autre ordinateur.
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
prénom | lire écrire | type | la description |
---|---|---|---|
CompareMode | lire écrire | Constante CompareMode | La définition de CompareMode ne peut être effectuée que sur un dictionnaire vide. Les valeurs acceptées sont 0 (vbBinaryCompare), 1 (vbTextCompare), 2 (vbDatabaseCompare). |
Compter | lecture seulement | entier long non signé | Un compte à base unique des paires clé / article dans l'objet du dictionnaire de script. |
Clé | lire écrire | variante non-tableau | Chaque clé unique dans le dictionnaire. |
Article ( clé ) | lire écrire | toute variante | Propriété par défaut Chaque élément individuel associé à une clé dans le dictionnaire. Notez que tenter de récupérer un élément avec une clé qui n'existe pas dans le dictionnaire ajoutera implicitement la clé transmise. |
Les méthodes
prénom | la description |
---|---|
Ajouter ( clé , article ) | Ajoute une nouvelle clé et un nouvel élément au dictionnaire. La nouvelle clé ne doit pas exister dans la collection Keys actuelle du dictionnaire, mais un élément peut être répété parmi de nombreuses clés uniques. |
Existe ( clé ) | Test booléen pour déterminer si une clé existe déjà dans le dictionnaire. |
Clés | Renvoie le tableau ou la collection de clés uniques. |
Articles | Renvoie le tableau ou la collection d'éléments associés. |
Supprimer ( clé ) | Supprime une clé de dictionnaire individuelle et son élément associé. |
Enlever tout | Efface toutes les clés et les éléments d'un objet du dictionnaire. |
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 deLog
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
.
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.
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
travailSummary
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
travailSummary
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.