VBA
Scripting.Dictionary object

Opmerkingen

Eigenschappen en methoden

Een Scripting Dictionary-object slaat informatie op in sleutel / item-paren. De sleutels moeten uniek zijn en geen array, maar de bijbehorende items kunnen worden herhaald (hun uniekheid wordt bewaard door de bijbehorende sleutel) en kunnen van elk type variant of object zijn.

Een woordenboek kan worden gezien als een tweeveldveld-geheugendatabase met een primaire unieke index op het eerste 'veld' (de sleutel ). Met deze unieke index op de eigenschap Keys kunnen zeer snelle 'lookups' de bijbehorende itemwaarde van een sleutel ophalen.

Eigendommen

methoden

Voorbeeldcode

'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

Gegevens verzamelen met Scripting.Dictionary (Maximum, Count)

Woordenboeken zijn geweldig voor het beheren van informatie wanneer meerdere vermeldingen voorkomen, maar u bent alleen bezig met een enkele waarde voor elke reeks vermeldingen - de eerste of laatste waarde, de minimale of maximale waarde, een gemiddelde, een som enz.

Overweeg een werkmap met een logboek van gebruikersactiviteit, met een script dat de gebruikersnaam en de bewerkingsdatum invoegt telkens wanneer iemand de werkmap bewerkt:

Log werkblad

EEN	B
bob	10/12/2016 9:00
alice	13-10-2016 13:00
bob	13-10-2016 13:30
alice	13-10-2016 14:00
alice	14-10-2016 13:00

Stel dat u de laatste bewerkingstijd voor elke gebruiker wilt uitvoeren in een werkblad met de naam Summary .

<sup>Opmerkingen:
1. De gegevens worden verondersteld in ActiveWorkbook .
2. We gebruiken een array om de waarden uit het werkblad te halen; dit is efficiënter dan elke cel herhalen.
3. Het Dictionary wordt gemaakt met vroege binding.</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

en de uitvoer ziet er zo uit:

Summary werkblad

EEN	B
bob	13-10-2016 13:30
alice	14-10-2016 13:00

Als u daarentegen wilt uitvoeren hoe vaak elke gebruiker de werkmap heeft bewerkt, ziet de body van de For lus er als volgt uit:

        '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

en de uitvoer ziet er zo uit:

Summary werkblad

EEN	B
bob	2
alice	3

Unieke waarden verkrijgen met Scripting.Dictionary

Met het Dictionary kunt u heel eenvoudig een unieke reeks waarden verkrijgen. Overweeg de volgende functie:

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

die je dan zo zou kunnen noemen:

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

en uniqueVals zouden slechts {1,2,3} .

Opmerking: deze functie kan worden gebruikt met elk opsombaar object.