Tabla hash / matriz asociativa en VBA

Parece que no puedo encontrar la documentación que explica cómo crear una tabla hash o una matriz asociativa en VBA. ¿Es posible?

¿Puede vincular a un artículo o, mejor aún, publicar el código?

Creo que está buscando el objeto Diccionario, que se encuentra en la biblioteca Microsoft Scripting Runtime. (Agregue una referencia a su proyecto desde el menú Herramientas … Referencias en el VBE).

Funciona prácticamente con cualquier valor simple que pueda caber en una variante (las claves no pueden ser matrices, y tratar de convertirlas en objetos no tiene mucho sentido. Consulte el comentario de @Nile a continuación).

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 

También puede usar el objeto Colección VBA si sus necesidades son más simples y solo quiere claves de cadena.

No sé si en realidad has hashes en algo, por lo que es posible que quieras profundizar más si necesitas un rendimiento parecido al de un hashtable. (EDITAR: Scripting.Dictionary utiliza internamente una tabla hash ).

He usado la clase HashTable de Francesco Balena varias veces en el pasado cuando una Colección o un Diccionario no encajaba perfectamente y solo necesitaba una HashTable.

Intenta usar el objeto de diccionario o el objeto de colección.

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

Aquí vamos … solo copie el código en un módulo, está listo para usar

 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 

Para usar en su aplicación 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