Hash Table / Associative Array w VBA


Odpowiedzi:


112

Myślę, że szukasz obiektu Dictionary, który znajduje się w bibliotece Microsoft Scripting Runtime. (Dodaj odniesienie do swojego projektu z menu Narzędzia ... References w VBE.)

Prawie działa z każdą prostą wartością, która mieści się w wariancie (klucze nie mogą być tablicami, a próba uczynienia ich obiektami nie ma większego sensu. Zobacz komentarz @Nile poniżej):

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

Możesz także użyć obiektu VBA Collection, jeśli Twoje potrzeby są prostsze i chcesz tylko klucze ciągów.

Nie wiem, czy któryś z nich rzeczywiście coś haszuje, więc możesz poszukać dalej, jeśli potrzebujesz wydajności podobnej do haszowania. (EDYCJA: Scripting.Dictionary wewnętrznie używa tablicy skrótów ).


tak - słownik jest odpowiedzią. Odpowiedź znalazłem również na tej stronie. stackoverflow.com/questions/915317/…
user158017

2
To całkiem dobra odpowiedź: ale klucze nigdy nie są obiektami - tak naprawdę dzieje się tak, że domyślna właściwość obiektu jest rzutowana jako łańcuch i używana jako klucz. Nie działa to, jeśli obiekt nie ma zdefiniowanej właściwości domyślnej (zwykle „nazwa”).
Nigel Heffernan

@Nile, dzięki. Widzę, że rzeczywiście masz rację. Wygląda również na to, że jeśli obiekt nie ma właściwości domyślnej, to odpowiadający mu klucz słownika jest Empty. Odpowiednio zredagowałem odpowiedź.
jtolle

Kilka struktur danych wyjaśnionych tutaj - analystcave.com/… Ten post pokazuje, jak używać tabel hash .NEXT w Excel VBA- stackoverflow.com/questions/8677949/ ...
johny why

powyżej literówka linku: .NET, nie .NEXT.
johny why



6

Zaczynamy ... po prostu skopiuj kod do modułu, jest gotowy do użycia

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

Aby użyć w aplikacji 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
Nie zamierzam głosować w dół zupełnie nowego użytkownika, który publikuje kod, ale zwykle wywołanie czegoś „tablicą mieszającą” oznacza, że ​​podstawowa implementacja jest w rzeczywistości tablicą mieszającą! Mamy tutaj tablicę asocjacyjną zaimplementowaną za pomocą zwykłej tablicy i wyszukiwania liniowego. Zobacz tutaj różnicę: en.wikipedia.org/wiki/Hash_table
jtolle

7
W rzeczy samej. Celem tablicy skrótów jest „haszowanie” klucza, co prowadzi do lokalizacji jego wartości w pamięci bazowej (lub przynajmniej wystarczająco blisko, w przypadku dozwolonych duplikatów kluczy), co eliminuje potrzebę potencjalnie kosztownego wyszukiwania.
Cor_Blimey,

4
Zbyt wolno dla większych tablic mieszających. Dodanie 17 000 wpisów zajmuje ponad 15 sekund. Za pomocą słownika mogę dodać 500 000 w mniej niż 6 sekund. 500 000 w mniej niż 3 sekundy przy użyciu funkcji hashtable mscorlib.
Christopher Thomas Nicodemus
Korzystając z naszej strony potwierdzasz, że przeczytałeś(-aś) i rozumiesz nasze zasady używania plików cookie i zasady ochrony prywatności.
Licensed under cc by-sa 3.0 with attribution required.