Tabela mieszania/Tablica asocjacyjna w języku VBA

Question

Nie mogę znaleźć dokumentacji wyjaśniającej, jak utworzyć tablicę asocjacyjną lub tablicę asocjacyjną w języku VBA. Czy to możliwe?

Czy możesz zamieścić link do artykułu lub jeszcze lepiej, a następnie opublikować kod?

Answer 1

myślę szukasz obiektu Dictionary, znalezionej w bibliotece Microsoft Scripting Runtime. (Dodaj odwołanie do swojego projektu z menu Narzędzia ... Odnośniki w VBE.)

To prawie działa z każdą prostą wartością, która może zmieścić się w wariancie (Klucze nie mogą być tablicami i próbują zrobić them obiektów nie ma sensu z @Nile Zobacz komentarz 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żna również użyć obiektu VBA kolekcja jeśli twoje potrzeby są prostsze i chcesz po prostu klucze ciągów.

Nie wiem, czy faktycznie haszysz na czymkolwiek, więc możesz chcieć kopać dalej, jeśli potrzebujesz wydajności podobnej do haka. (EDYCJA: Scripting.Dictionary używa wewnętrznie hash table).

Answer 2

Spróbuj użyć obiektu Dictionary lub obiektu Collection.

http://visualbasic.ittoolbox.com/documents/dictionary-object-vs-collection-object-12196

Answer 3

Kilka razy używałam w przeszłości Francesco Balena's HashTable class, gdy kolekcja lub słownik nie pasował idealnie i potrzebowałem właśnie tablicy HashTable.

Answer 4

Zaczynamy ... po prostu skopiuj kod do modułu, to 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 

do wykorzystania w 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