Tabla hash/matriz asociativa en VBA

Question

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

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

Answer 1

creo que busca el objeto Dictionary, 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 tratando de hacer convierten en objetos no tiene mucho sentido Véase el comentario de @Nile abajo):..

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 utilizar el objeto VBA Colección si sus necesidades son más simples y que sólo quieren claves de cadena.

No sé si en realidad has hash en nada, por lo que es posible que quieras profundizar si necesitas un rendimiento similar al de hashtable. (EDITAR: Scripting.Dictionary usa internamente un hash table)

Answer 2

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

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

Answer 3

He usado Francesco Balena's HashTable class varias veces en el pasado cuando una colección o un diccionario no encajaban perfectamente y solo necesitaba una HashTable.

Answer 4

Aquí vamos ... sólo tienes que copiar el código a un módulo, que 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 utilizar en su VB (A) Aplicación:

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