Je n'arrive pas à trouver la documentation expliquant comment créer une table de hachage ou un tableau associatif dans VBA. Est-ce même possible?
Pouvez-vous créer un lien vers un article ou mieux encore publier le code?
Je n'arrive pas à trouver la documentation expliquant comment créer une table de hachage ou un tableau associatif dans VBA. Est-ce même possible?
Pouvez-vous créer un lien vers un article ou mieux encore publier le code?
Réponses:
Je pense que vous recherchez l'objet Dictionary, trouvé dans la bibliothèque Microsoft Scripting Runtime. (Ajoutez une référence à votre projet à partir du menu Outils ... Références dans le VBE.)
Cela fonctionne à peu près avec n'importe quelle valeur simple pouvant tenir dans une variante (les clés ne peuvent pas être des tableaux, et essayer d'en faire des objets 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'objet Collection VBA si vos besoins sont plus simples et que vous ne voulez que des clés de chaîne.
Je ne sais pas si l'un ou l'autre hache réellement quelque chose, vous voudrez peut-être approfondir votre recherche si vous avez besoin de performances de type table de hachage. (EDIT: Scripting.Dictionary utilise une table de hachage en interne.)
Empty
. J'ai édité la réponse en conséquence.
J'ai utilisé la classe HashTable de Francesco Balena plusieurs fois dans le passé lorsqu'une collection ou un dictionnaire ne correspondait pas parfaitement et que j'avais juste besoin d'un HashTable.
Essayez d'utiliser l'objet Dictionary ou l'objet Collection.
http://visualbasic.ittoolbox.com/documents/dictionary-object-vs-collection-object-12196
On y va ... il suffit de copier le code dans un module, c'est prêt à l'emploi
Private Type hashtable
key As Variant
value As Variant
End Type
Private GetErrMsg As String
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
À 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