Table de hachage / tableau associatif en VBA

Je n’arrive pas à trouver la documentation expliquant comment créer une table de hachage ou un tableau associatif dans VBA. Est-ce que c’est même possible?

Pouvez-vous créer un lien vers un article ou mieux encore publier le code?

    Je pense que vous recherchez l’object Dictionary, trouvé dans la bibliothèque Microsoft Scripting Runtime. (Ajoutez une référence à votre projet dans le menu Outils … Références du VBE.)

    Cela fonctionne à peu près avec n’importe quelle valeur simple qui peut tenir dans une variante (les clés ne peuvent pas être des tableaux, et essayer de les rendre n’a pas beaucoup de sens. Voir le commentaire de @Nile ci-dessous):

    Dim d As dictionary Set d = New dictionary d("x") = 42 d(42) = "forty-two" d(CVErr(xlErrValue)) = "Excel #VALUE!" Set d(101) = New Collection 

    Vous pouvez également utiliser l’object Collection VBA si vos besoins sont plus simples et que vous souhaitez simplement des clés de chaîne.

    Je ne sais pas si l’un ou l’autre est en train de hacher quelque chose, alors vous voudrez peut-être aller plus loin si vous avez besoin d’une performance de type hashtable. (EDIT: Scripting.Dictionary utilise une table de hachage en interne.)

    J’ai déjà utilisé plusieurs fois la classe HashTable de Francesco Balena quand une collection ou un dictionnaire ne convenait pas parfaitement et j’avais juste besoin d’une table de hachage.

    Essayez d’utiliser l’object Dictionary ou l’object Collection.

    http://visualbasic.ittoolbox.com/documents/dictionary-object-vs-collection-object-12196

    Voilà, il suffit de copier le code dans un module, il est prêt à être utilisé

     Private Type hashtable key As Variant value As Variant End Type Private GetErrMsg As Ssortingng Private Function CreateHashTable(htable() As hashtable) As Boolean GetErrMsg = "" On Error GoTo CreateErr ReDim htable(0) CreateHashTable = True Exit Function CreateErr: CreateHashTable = False GetErrMsg = Err.Description End Function Private Function AddValue(htable() As hashtable, key As Variant, value As Variant) As Long GetErrMsg = "" On Error GoTo AddErr Dim idx As Long idx = UBound(htable) + 1 Dim htVal As hashtable htVal.key = key htVal.value = value Dim i As Long For i = 1 To UBound(htable) If htable(i).key = key Then Err.Raise 9999, , "Key [" & CStr(key) & "] is not unique" Next i ReDim Preserve htable(idx) htable(idx) = htVal AddValue = idx Exit Function AddErr: AddValue = 0 GetErrMsg = Err.Description End Function Private Function RemoveValue(htable() As hashtable, key As Variant) As Boolean GetErrMsg = "" On Error GoTo RemoveErr Dim i As Long, idx As Long Dim htTemp() As hashtable idx = 0 For i = 1 To UBound(htable) If htable(i).key <> key And IsEmpty(htable(i).key) = False Then ReDim Preserve htTemp(idx) AddValue htTemp, htable(i).key, htable(i).value idx = idx + 1 End If Next i If UBound(htable) = UBound(htTemp) Then Err.Raise 9998, , "Key [" & CStr(key) & "] not found" htable = htTemp RemoveValue = True Exit Function RemoveErr: RemoveValue = False GetErrMsg = Err.Description End Function Private Function GetValue(htable() As hashtable, key As Variant) As Variant GetErrMsg = "" On Error GoTo GetValueErr Dim found As Boolean found = False For i = 1 To UBound(htable) If htable(i).key = key And IsEmpty(htable(i).key) = False Then GetValue = htable(i).value Exit Function End If Next i Err.Raise 9997, , "Key [" & CStr(key) & "] not found" Exit Function GetValueErr: GetValue = "" GetErrMsg = Err.Description End Function Private Function GetValueCount(htable() As hashtable) As Long GetErrMsg = "" On Error GoTo GetValueCountErr GetValueCount = UBound(htable) Exit Function GetValueCountErr: GetValueCount = 0 GetErrMsg = Err.Description End Function 

    Pour utiliser dans votre application VB (A):

     Public Sub Test() Dim hashtbl() As hashtable Debug.Print "Create Hashtable: " & CreateHashTable(hashtbl) Debug.Print "" Debug.Print "ID Test Add V1: " & AddValue(hashtbl, "Hallo_0", "Testwert 0") Debug.Print "ID Test Add V2: " & AddValue(hashtbl, "Hallo_0", "Testwert 0") Debug.Print "ID Test 1 Add V1: " & AddValue(hashtbl, "Hallo.1", "Testwert 1") Debug.Print "ID Test 2 Add V1: " & AddValue(hashtbl, "Hallo-2", "Testwert 2") Debug.Print "ID Test 3 Add V1: " & AddValue(hashtbl, "Hallo 3", "Testwert 3") Debug.Print "" Debug.Print "Test 1 Removed V1: " & RemoveValue(hashtbl, "Hallo_1") Debug.Print "Test 1 Removed V2: " & RemoveValue(hashtbl, "Hallo_1") Debug.Print "Test 2 Removed V1: " & RemoveValue(hashtbl, "Hallo-2") Debug.Print "" Debug.Print "Value Test 3: " & CStr(GetValue(hashtbl, "Hallo 3")) Debug.Print "Value Test 1: " & CStr(GetValue(hashtbl, "Hallo_1")) Debug.Print "" Debug.Print "Hashtable Content:" For i = 1 To UBound(hashtbl) Debug.Print CStr(i) & ": " & CStr(hashtbl(i).key) & " - " & CStr(hashtbl(i).value) Next i Debug.Print "" Debug.Print "Count: " & CStr(GetValueCount(hashtbl)) End Sub