VBA
Scripting. Oggetto letterario

Osservazioni

Proprietà e metodi

Un oggetto Scripting Dictionary memorizza le informazioni nelle coppie chiave / oggetto. Le chiavi devono essere uniche e non un array, ma gli articoli associati possono essere ripetuti (la loro unicità è detenuta dalla chiave companion) e possono essere di qualsiasi tipo di variante o oggetto.

Un dizionario può essere considerato come un database di due campi in memoria con un indice univoco primario sul primo 'campo' (la chiave ). Questo indice univoco sulla proprietà Keys consente "ricerche" molto rapide per recuperare il valore dell'articolo associato di una chiave.

Proprietà

metodi

Codice di esempio

'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

Dati aggregati con Scripting.Dictionary (Maximum, Count)

I dizionari sono grandi per la gestione delle informazioni in cui si verificano più voci, ma si è interessati solo a un singolo valore per ogni insieme di voci: il primo o l'ultimo valore, il mininmum o il valore massimo, una media, una somma, ecc.

Considera una cartella di lavoro che contiene un registro dell'attività dell'utente, con uno script che inserisce il nome utente e modifica la data ogni volta che qualcuno modifica la cartella di lavoro:

Log foglio di lavoro

UN	B
peso	10/12/2016 9:00
alice	13/10/2016 13:00
peso	13/10/2016 13:30
alice	13/10/2016 14:00
alice	14/10/2016 13:00

Supponiamo di voler emettere l'ultima ora di modifica per ciascun utente in un foglio di lavoro denominato Summary .

<sup>Gli appunti:
1. Si presume che i dati siano in ActiveWorkbook .
2. Stiamo usando una matrice per estrarre i valori dal foglio di lavoro; questo è più efficiente di iterare su ogni cella.
3. Il Dictionary viene creato utilizzando l'associazione anticipata.</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

e l'output sarà simile a questo:

Foglio di lavoro Summary

UN	B
peso	13/10/2016 13:30
alice	14/10/2016 13:00

Se invece vuoi mostrare quante volte ogni utente ha modificato la cartella di lavoro, il corpo del ciclo For dovrebbe apparire così:

        '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

e l'output sarà simile a questo:

Foglio di lavoro Summary

UN	B
peso	2
alice	3

Ottenere valori univoci con Scripting.Dictionary

Il Dictionary consente di ottenere un insieme di valori unico in modo molto semplice. Considera la seguente funzione:

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

che puoi chiamare così:

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

e uniqueVals conterrebbe solo {1,2,3} .

Nota: questa funzione può essere utilizzata con qualsiasi oggetto enumerabile.