Tabel Hash / Array Asosiatif di VBA


Jawaban:


112

Saya rasa Anda sedang mencari objek Dictionary, yang ditemukan di perpustakaan Microsoft Scripting Runtime. (Tambahkan referensi ke proyek Anda dari menu Alat ... Referensi di VBE.)

Ini cukup banyak berfungsi dengan nilai sederhana apa pun yang dapat ditampung dalam varian (Kunci tidak boleh berupa array, dan mencoba menjadikannya objek tidak masuk akal. Lihat komentar dari @Nile di bawah.):

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

Anda juga dapat menggunakan objek Koleksi VBA jika kebutuhan Anda lebih sederhana dan Anda hanya ingin kunci string.

Saya tidak tahu apakah keduanya benar-benar melakukan hash pada sesuatu, jadi Anda mungkin ingin menggali lebih jauh jika Anda membutuhkan kinerja seperti hashtable. (EDIT: Scripting.Dictionary memang menggunakan tabel hash secara internal.)


ya - kamus adalah jawabannya. Saya menemukan jawabannya di situs ini juga. stackoverflow.com/questions/915317/…
user158017

2
Itu jawaban yang cukup bagus: tetapi kuncinya tidak pernah menjadi objek - apa yang sebenarnya terjadi adalah properti default dari objek tersebut dilemparkan sebagai string dan digunakan sebagai kuncinya. Ini tidak berfungsi jika objek tidak memiliki properti default (biasanya 'nama') yang ditentukan.
Nigel Heffernan

@Nile, Terima kasih. Saya melihat bahwa Anda memang benar. Ini juga terlihat seperti jika objek tidak memiliki properti default, maka kunci kamus yang sesuai adalah Empty. Saya mengedit jawaban yang sesuai.
jtolle

Beberapa struktur data dijelaskan di sini- analystcave.com/… Posting ini menunjukkan cara menggunakan .NEXT hashtables di Excel VBA- stackoverflow.com/questions/8677949/…
johny why

link di atas salah ketik: .NET, bukan .NEXT.
johny kenapa



6

Ini dia ... cukup salin kode ke modul, itu siap digunakan

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

Untuk digunakan di Aplikasi VB (A) Anda:

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
Saya tidak akan merendahkan pengguna baru yang memposting kode, tetapi biasanya memanggil sesuatu "tabel hash" menyiratkan bahwa implementasi yang mendasarinya sebenarnya adalah tabel hash! Apa yang Anda miliki di sini adalah array asosiatif yang diimplementasikan dengan array biasa ditambah pencarian linier. Lihat di sini untuk perbedaannya: en.wikipedia.org/wiki/Hash_table
jtolle

7
Memang. Inti dari tabel hash adalah 'hashing' kunci mengarah ke lokasi nilainya di penyimpanan yang mendasarinya (atau setidaknya cukup dekat, dalam kasus kunci duplikat diperbolehkan), oleh karena itu menghilangkan kebutuhan untuk pencarian yang berpotensi mahal.
Cor_Blimey

4
Terlalu lambat untuk hashtable yang lebih besar. Menambahkan 17.000 entri membutuhkan waktu lebih dari 15 detik. Saya dapat menambahkan 500.000 dalam waktu kurang dari 6 detik menggunakan kamus. 500.000 dalam waktu kurang dari 3 detik menggunakan mscorlib hashtable.
Christopher Thomas Nicodemus
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.