VBA: Gestione di un Dizionario

No, non si tratta dell’oggetto Scripting.Dictionary – del quale, peraltro, vi consiglio l’uso, se potete – il cui utilizzo è ampiamente documentato in rete ma, bensì, una mia ristrettissima implementazione.

In pratica, senza dover caricare librerie aggiuntive (operazione che mi sembra abbia una pessima portabilità, tende a dare problemi appena si cambia PC con magari una versione Windows diversa), ho preferito crearmi io qualcosa di basato su quanto il linguaggio VBA offre.

Iniziamo quindi dalla dichiarazione del tipo:

Type Dizionario
    Chiave          As String
    Valore          As String
End Type

Banale, vero ?

Semplicemente un’accoppiata Chiave/Valore, tipica dei Dizionari.

Come tutti – o quasi – i Dizionari – che conosco io – la mia implementazione ha le seguenti caratteristiche:

1. Le chiavi sono Case Sensitive; una chiave di nome “pippo” è diversa da “Pippo”, tanto per intenderci.
2. Non è possibile aggiungere più volte la medesima chiave (salvo non abbia minuscole/MAIUSCOLE diverse, appunto, vedi regola [1]).
3. Le chiavi sono nell’ordine con le quali vengono inserite.
4. È possibile modificare i valori delle chiavi.
5. È possibile eliminare le chiavi.
6. Il valore delle chiavi è una stringa; nulla però vi impedisce di modificare la mia implementazione e utilizzare qualsiasi altra cosa il linguaggio consenta.

Ok, veniamo alla funzione che serve per modificare il dizionario (Aggiungere, Modificare e Togliere chiavi):

Sub DizionarioModifica( _
    vDizionario() As Dizionario, _
    sChiave As String, _
    sValore As String, _
    Optional bModifica As Boolean = False, _
    Optional bElimina As Boolean = False)
    Dim lDictSize   As Long: lDictSize = 0
    Dim lIndex      As Long: lIndex = 0
    
    If sChiave = "" _
    And bElimina = False Then Exit Sub
    
    On Error Resume Next
    lDictSize = UBound(vDizionario)
    
    If lDictSize = 0 Then
        If bElimina = True Then Exit Sub
        
        lDictSize = 1
        ReDim Preserve vDizionario(lDictSize)
        vDizionario(lDictSize - 1).Chiave = sChiave
        vDizionario(lDictSize - 1).Valore = sValore
    Else
        ' PRIMA SI ACCERTA CHE LA CHIAVE NON SIA GIA' PRESENTE.
        For lIndex = 0 To lDictSize
            If vDizionario(lIndex).Chiave = sChiave Then
                If bElimina = True Then
                    If lIndex < lDictSize - 1 Then
                        vDizionario(lIndex).Chiave = vDizionario(lIndex + 1).Chiave
                        vDizionario(lIndex).Valore = vDizionario(lIndex + 1).Valore
                        sChiave = vDizionario(lIndex + 1).Chiave
                    Else
                        lDictSize = lDictSize - 2
                    End If
                Else
                    If bModifica = False Then Exit Sub
                    
                    vDizionario(lIndex).Valore = sValore
                    Exit Sub
                End If
            End If
        Next
        
        lDictSize = lDictSize + 1
        
        ReDim Preserve vDizionario(lDictSize)
        If bElimina = True Then Exit Sub
        vDizionario(lDictSize - 1).Chiave = sChiave
        vDizionario(lDictSize - 1).Valore = sValore
    End If
End Sub

La sub-routine “DizionarioModifica” accetta nell’ordine l’array dizionario, la chiave da gestire, l’eventuale valore e, opzionalmente, i flag booleani bModifica e bElimina che servono rispettivamente per abilitare la modifica del valore o l’eliminazione della chiave.

Dopodiché abbiamo la funzione per cercare una chiave all’interno del dizionario:

Function DizionarioCerca( _
    vDizionario() As Dizionario, _
    sChiave As String, _
    ByRef sValore As String) As Boolean
    DizionarioCerca = False
    Dim lDictSize   As Long: lDictSize = 0
    Dim l As Long
    
    On Error Resume Next
    lDictSize = UBound(vDizionario)
    
    If lDictSize = 0 Then Exit Function
    
    For l = 0 To UBound(vDizionario) - 1
        If vDizionario(l).Chiave = sChiave Then
            sValore = vDizionario(l).Valore
            DizionarioCerca = True
            Exit Function
        End If
    Next l
End Function

Questa funzione “DizionarioCerca” ritorna un valore booleano True se ha successo, altrimenti, False; la ricerca prevede che venga passato l’array del dizionario, la chiave da cercare e una variabile contenitore stringa che ha il compito di ricevere l’eventuale valore individuato.

Perdonatemi, non consente di sapere se c’è una o più chiavi che hanno un determinato valore: per i miei scopi la cosa non serviva e non l’ho implementata. Ma, prendendo spunto, non credo sarà troppo difficile colmare la cosa.

Incollo un codice di test che ho usato per verificare tutto funzionasse come previsto:

Sub test()
    Dim vDizionario() As Dizionario
    Dim sValore As String
    
    If DizionarioCerca( _
        vDizionario, _
        "sChiave", _
        sValore) = False Then
        Debug.Print "Chiave non trovata."
    Else
        Debug.Print "sValore = " & sValore
    End If
    
    DizionarioModifica vDizionario, "sChiave", "sValore"
    DizionarioModifica vDizionario, "sChiave", "sValore"
    DizionarioModifica vDizionario, "sChiave", "sValore1", True
    DizionarioModifica vDizionario, "sChiave2", "sValore1", True
    DizionarioModifica vDizionario, "sChiave2", "sValore2", True
    DizionarioModifica vDizionario, "sChiave3", "sValore3"
    DizionarioModifica vDizionario, "sChiave3", "sValore4"
    DizionarioModifica vDizionario, "sChiave", "sValore", True, True
    DizionarioModifica vDizionario, "sChiave", "sValore"
    DizionarioModifica vDizionario, "sChiave3", "sValore", True
    
    Dim l As Long
    For l = 0 To UBound(vDizionario) - 1
        Debug.Print vDizionario(l).Chiave & " = " & vDizionario(l).Valore
    Next l
    
    If DizionarioCerca( _
        vDizionario, _
        "sChiave2", _
        sValore) = False Then
        Debug.Print "Chiave non trovata."
    Else
        Debug.Print "sValore = " & sValore
    End If
    If DizionarioCerca( _
        vDizionario, _
        "sChiave4", _
        sValore) = False Then
        Debug.Print "Chiave non trovata."
    Else
        Debug.Print "sValore = " & sValore
    End If
    Debug.Print "END"
End Sub