Não consigo encontrar a documentação explicando como criar uma tabela hash ou array associativo no VBA. É mesmo possível?
Você pode criar um link para um artigo ou, melhor ainda, postar o código?
Não consigo encontrar a documentação explicando como criar uma tabela hash ou array associativo no VBA. É mesmo possível?
Você pode criar um link para um artigo ou, melhor ainda, postar o código?
Respostas:
Acho que você está procurando o objeto Dictionary, encontrado na biblioteca do Microsoft Scripting Runtime. (Adicione uma referência ao seu projeto no menu Ferramentas ... Referências no VBE.)
Funciona muito bem com qualquer valor simples que possa caber em uma variante (chaves não podem ser arrays e tentar transformá-las em objetos não faz muito sentido. Veja o comentário de @Nile abaixo).
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
Você também pode usar o objeto Coleção VBA se suas necessidades forem mais simples e você quiser apenas chaves de string.
Não sei se algum dos dois realmente faz hash em alguma coisa, então você pode querer cavar mais se precisar de um desempenho semelhante a hashtable. (EDIT: Scripting.Dictionary usa uma tabela hash internamente.)
Empty
. Eu editei a resposta de acordo.
Eu usei a classe HashTable de Francesco Balena várias vezes no passado, quando uma coleção ou dicionário não era um ajuste perfeito e eu só precisava de uma HashTable.
Tente usar o objeto Dicionário ou o objeto Coleção.
http://visualbasic.ittoolbox.com/documents/dictionary-object-vs-collection-object-12196
Vamos lá ... basta copiar o código para um módulo, está pronto 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 em seu aplicativo 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