Tabella hash / Array associativo in VBA


Risposte:


109

Penso che tu stia cercando l'oggetto Dictionary, che si trova nella libreria Microsoft Scripting Runtime. (Aggiungi un riferimento al tuo progetto dal menu Strumenti ... Riferimenti nel VBE.)

Funziona praticamente con qualsiasi valore semplice che possa adattarsi a una variante (le chiavi non possono essere array e cercare di renderle oggetti non ha molto senso. Vedi il commento di @Nile di seguito.):

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

Puoi anche utilizzare l'oggetto VBA Collection se le tue esigenze sono più semplici e desideri solo chiavi stringa.

Non so se uno dei due ha effettivamente hash su qualcosa, quindi potresti voler approfondire se hai bisogno di prestazioni simili a hashtable. (EDIT: Scripting.Dictionary utilizza internamente una tabella hash .)


sì, il dizionario è la risposta. Ho trovato la risposta anche su questo sito. stackoverflow.com/questions/915317/...
user158017

2
Questa è una risposta abbastanza buona: ma le chiavi non sono mai oggetti: ciò che sta realmente accadendo è che la proprietà predefinita dell'oggetto viene espressa come una stringa e utilizzata come chiave. Questo non funziona se l'oggetto non ha una proprietà predefinita (di solito "nome") definita.
Nigel Heffernan

@ Nilo, grazie. Vedo che hai davvero ragione. Sembra anche che se l'oggetto non ha una proprietà predefinita, la chiave del dizionario corrispondente lo è Empty. Ho modificato la risposta di conseguenza.
jtolle

Diversi data-strutture spiegato qui- analystcave.com/...~~V~~plural~~3rd questo post mostra come usare hashtables .Next in Excel VBA- stackoverflow.com/questions/8677949/...
Johny perché

errore di battitura sopra: .NET, non .NEXT.
johny why il



6

Ecco fatto ... copia il codice su un modulo, è pronto per l'uso

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

Da utilizzare nella tua app 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
Non ho intenzione di downvote un nuovo utente che pubblica codice, ma di solito chiamare qualcosa una "tabella hash" implica che l'implementazione sottostante è in realtà una tabella hash! Quello che hai qui è un array associativo implementato con un array regolare più una ricerca lineare. Vedi qui per la differenza: en.wikipedia.org/wiki/Hash_table
jtolle

7
Infatti. Il punto di una tabella hash è che l '' hashing 'della chiave porta alla posizione del suo valore nella memoria sottostante (o almeno abbastanza vicino, nel caso di chiavi duplicate consentite), eliminando quindi la necessità di una ricerca potenzialmente costosa.
Cor_Blimey

3
Troppo lento per hashtable più grandi. L'aggiunta di 17.000 voci richiede più di 15 secondi. Posso aggiungere 500.000 in meno di 6 secondi usando il dizionario. 500.000 in meno di 3 secondi utilizzando mscorlib hashtable.
Christopher Thomas Nicodemus
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.