Hash-Tabelle / assoziatives Array in VBA

Antworten:

109

Ich denke, Sie suchen nach dem Dictionary-Objekt, das sich in der Microsoft Scripting Runtime-Bibliothek befindet. (Fügen Sie im Menü Extras ... Referenzen in der VBE einen Verweis auf Ihr Projekt hinzu.)

Es funktioniert so ziemlich mit jedem einfachen Wert, der in eine Variante passt (Schlüssel können keine Arrays sein, und der Versuch, sie zu Objekten zu machen, macht wenig Sinn. Siehe Kommentar von @Nile unten.):

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

Sie können das VBA Collection-Objekt auch verwenden, wenn Ihre Anforderungen einfacher sind und Sie nur Zeichenfolgenschlüssel benötigen.

Ich weiß nicht, ob einer der beiden tatsächlich etwas hasht, daher möchten Sie vielleicht weiter graben, wenn Sie eine hashtable-ähnliche Leistung benötigen. (EDIT: Scripting.Dictionary verwendet intern eine Hash-Tabelle .)

jtolle
quelle
Ja - Wörterbuch ist die Antwort. Die Antwort habe ich auch auf dieser Seite gefunden. stackoverflow.com/questions/915317/…
user158017
2
Das ist eine gute Antwort: Aber die Schlüssel sind niemals Objekte. Was tatsächlich passiert, ist, dass die Standardeigenschaft des Objekts als Zeichenfolge umgewandelt und als Schlüssel verwendet wird. Dies funktioniert nicht, wenn für das Objekt keine Standardeigenschaft (normalerweise 'Name') definiert ist.
Nigel Heffernan
@ Nil, danke. Ich sehe, dass Sie in der Tat richtig sind. Es sieht auch so aus, als ob das Objekt keine Standardeigenschaft hat, dann ist der entsprechende Wörterbuchschlüssel Empty. Ich habe die Antwort entsprechend bearbeitet.
Jtolle
Einige Datenstrukturen hier erklärt-analytiker.com/ Dieser Beitrag zeigt, wie .NEXT-Hashtabellen in Excel VBA- stackoverflow.com/questions/8677949/… verwendet werden
Johny, warum
Tippfehler über dem Link: .NET, nicht .NEXT.
Johny, warum
6

Los geht's ... kopieren Sie einfach den Code in ein Modul, es ist einsatzbereit

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

So verwenden Sie es in Ihrer VB (A) App:

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
Stefan0410
quelle
18
Ich werde keinen brandneuen Benutzer, der Code veröffentlicht, ablehnen, aber normalerweise bedeutet das Aufrufen einer "Hash-Tabelle", dass die zugrunde liegende Implementierung tatsächlich eine Hash-Tabelle ist! Was Sie hier haben, ist ein assoziatives Array, das mit einem regulären Array plus einer linearen Suche implementiert ist. Siehe hier für den Unterschied: en.wikipedia.org/wiki/Hash_table
jtolle
7
Tatsächlich. Der Punkt einer Hash-Tabelle ist, dass das "Hashing" des Schlüssels dazu führt, dass sich sein Wert im zugrunde liegenden Speicher befindet (oder zumindest nahe genug, wenn doppelte Schlüssel zulässig sind), sodass keine potenziell kostspielige Suche erforderlich ist.
Cor_Blimey
3
Viel zu langsam für größere Hashtabellen. Das Hinzufügen von 17.000 Einträgen dauert mehr als 15 Sekunden. Mit dem Wörterbuch kann ich in weniger als 6 Sekunden 500.000 hinzufügen. 500.000 in weniger als 3 Sekunden mit mscorlib Hashtable.
Christopher Thomas Nicodemus