VBA
Obiekt Scripting.Dictionary

Uwagi

Właściwości i metody

Obiekt Scripting Dictionary przechowuje informacje w parach Key / Item. Klucze muszą być unikalne, a nie tablica, ale skojarzone Przedmioty mogą się powtarzać (ich unikalność jest utrzymywana przez Klucz towarzyszący) i mogą być dowolnego rodzaju wariantem lub przedmiotem.

Słownik można traktować jako bazę danych z dwoma polami w pamięci z pierwotnym unikalnym indeksem na pierwszym „polu” ( kluczu ). Ten unikalny indeks właściwości Keys umożliwia bardzo szybkie „wyszukiwanie” w celu odzyskania wartości przedmiotu powiązanej z kluczem.

Nieruchomości

Metody

Przykładowy kod

'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

Agregowanie danych za pomocą Scripting.Dictionary (Maximum, Count)

Słowniki świetnie nadają się do zarządzania informacjami, w których występuje wiele wpisów, ale dotyczy tylko jednej wartości dla każdego zestawu wpisów - pierwszej lub ostatniej wartości, wartości minimalnej lub maksymalnej, średniej, sumy itp.

Rozważ skoroszyt zawierający dziennik aktywności użytkownika ze skryptem, który wstawia nazwę użytkownika i edytuje datę za każdym razem, gdy ktoś edytuje skoroszyt:

Log arkusz roboczy

ZA	b
kok	10/12/2016 9:00
alicja	13.10.2016 13:00
kok	13.10.2016 13:30
alicja	13.10.2016 14:00
alicja	14.10.2016 13:00

Powiedzmy, że chcesz wyprowadzić czas ostatniej edycji dla każdego użytkownika w arkuszu roboczym o nazwie Summary .

<sup>Uwagi:
1. Zakłada się, że dane znajdują się w ActiveWorkbook .
2. Używamy tablicy do pobierania wartości z arkusza roboczego; jest to bardziej wydajne niż iteracja po każdej komórce.
3. Dictionary jest tworzony przy użyciu wczesnego wiązania.</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

i wynik będzie wyglądał następująco:

Arkusz Summary

ZA	b
kok	13.10.2016 13:30
alicja	14.10.2016 13:00

Jeśli z drugiej strony chcesz wypisać, ile razy każdy użytkownik edytował skoroszyt, treść pętli For powinna wyglądać następująco:

        '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

i wynik będzie wyglądał następująco:

Arkusz Summary

ZA	b
kok	2)
alicja	3)

Uzyskiwanie unikalnych wartości za pomocą Scripting.Dictionary

Dictionary pozwala w bardzo prosty sposób uzyskać unikalny zestaw wartości. Rozważ następującą funkcję:

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

który możesz nazwać tak:

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

i uniqueVals zawierałyby tylko {1,2,3} .

Uwaga: Ta funkcja może być używana z dowolnym obiektem zliczalnym.