VBA
Scripting.Diction-objekt

Anmärkningar

Egenskaper och metoder

Ett Scripting Dictionary-objekt lagrar information i nyckel- / objektpar. Nycklarna måste vara unika och inte en matris men de tillhörande artiklarna kan upprepas (deras unikhet hålls av ledsagarnyckeln) och kan vara av alla typer av varianter eller objekt.

En ordbok kan betraktas som en tvåfält i minnesdatabas med ett primärt unikt index på det första 'fältet' ( nyckeln ). Det här unika indexet för Keys-egenskapen tillåter mycket snabba "sökningar" att hämta en nyckels tillhörande objektvärde.

Egenskaper

metoder

Exempelkod

'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

Samla data med Scripting.Diction (Maximum, Count)

Ordböcker är bra för att hantera information där flera poster inträffar, men du är bara upptagen med ett enda värde för varje uppsättning poster - det första eller sista värdet, mininmum eller maximivärde, ett genomsnitt, en summa etc.

Tänk på en arbetsbok som innehåller en logg över användaraktivitet, med ett skript som sätter in användarnamn och redigeringsdatum varje gång någon redigerar arbetsboken:

Log kalkylbladet

EN	B
guppa	10/12/2016 9:00
alice	10/13/2016 13:00
guppa	10/13/2016 13:30
alice	10/13/2016 14:00
alice	10/14/2016 13:00

Låt oss säga att du vill mata ut den senaste redigeringstiden för varje användare i ett kalkylblad som heter Summary .

<sup>Anmärkningar:
1. ActiveWorkbook antas vara i ActiveWorkbook .
2. Vi använder en matris för att dra värdena från kalkylbladet; detta är mer effektivt än att iterera över varje cell.
3. Dictionary skapas med tidig bindning.</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

och utgången ser ut så här:

Summary kalkylblad

EN	B
guppa	10/13/2016 13:30
alice	10/14/2016 13:00

Om du å andra sidan vill skriva ut hur många gånger varje användare redigerade arbetsboken, ska kroppen på For slingan se ut så här:

        '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

och utgången ser ut så här:

Summary kalkylblad

EN	B
guppa	2
alice	3

Få unika värden med Scripting.Diction

Dictionary gör det möjligt att få en unik uppsättning värden mycket enkelt. Tänk på följande funktion:

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

som du då kan kalla så här:

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

och uniqueVals skulle innehålla endast {1,2,3} .

Obs: Denna funktion kan användas med valfritt antal objekt.