Tabela de hash / matriz associativa em VBA


Respostas:


109

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.)


sim - dicionário é a resposta. Eu encontrei a resposta neste site também. stackoverflow.com/questions/915317/…
user158017

2
Essa é uma resposta muito boa: mas as chaves nunca são objetos - o que realmente está acontecendo é que a propriedade padrão do objeto está sendo convertida como uma string e usada como a chave. Isso não funciona se o objeto não tiver nenhuma propriedade padrão (geralmente 'nome') definida.
Nigel Heffernan

@Nile, obrigado. Vejo que você está realmente correto. Também parece que, se o objeto não tiver propriedade padrão, a chave de dicionário correspondente terá Empty. Eu editei a resposta de acordo.
jtolle

Várias estruturas de dados explicadas aqui- analistacave.com/… Este artigo mostra como usar hashtables .NEXT no Excel VBA- stackoverflow.com/questions/8677949/…
johny porque

erro de digitação do link acima: .NET, não .NEXT.
johny porque



6

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

18
Não vou rebaixar a votação de um novo usuário que posta código, mas normalmente chamar algo de "tabela hash" implica que a implementação subjacente é, na verdade, uma tabela hash! O que você tem aqui é um array associativo implementado com um array regular mais uma pesquisa linear. Veja aqui a diferença: en.wikipedia.org/wiki/Hash_table
jtolle

7
De fato. O ponto de uma tabela hash é que o 'hash' da chave leva à localização de seu valor no armazenamento subjacente (ou pelo menos próximo o suficiente, no caso de chaves duplicadas permitidas), eliminando, portanto, a necessidade de uma pesquisa potencialmente cara.
Cor_Blimey

3
Muito lento para hashtables maiores. Adicionar 17.000 entradas leva mais de 15 segundos. Posso adicionar 500.000 em menos de 6 segundos usando o dicionário. 500.000 em menos de 3 segundos usando hashtable mscorlib.
Christopher Thomas Nicodemus
Ao utilizar nosso site, você reconhece que leu e compreendeu nossa Política de Cookies e nossa Política de Privacidade.
Licensed under cc by-sa 3.0 with attribution required.