VBA의 해시 테이블 / 연관 배열

Question 1

VBA에서 해시 테이블 또는 연관 배열을 만드는 방법을 설명하는 설명서를 찾을 수없는 것 같습니다. 가능할까요?

기사에 링크하거나 코드를 게시 할 수 있습니까?

Question 2

Microsoft Scripting Runtime 라이브러리에있는 Dictionary 개체를 찾고 있다고 생각합니다. (VBE의 도구 ... 참조 메뉴에서 프로젝트에 대한 참조를 추가하십시오.)

변형에 맞출 수있는 간단한 값으로 거의 작동합니다 (키는 배열이 될 수 없으며 객체로 만드는 것은 의미가 없습니다. 아래 @Nile의 주석을 참조하십시오.) :

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

요구 사항이 더 간단하고 문자열 키만 원하는 경우 VBA 컬렉션 개체를 사용할 수도 있습니다.

둘 중 어느 쪽이 실제로 어떤 것을 해시하는지는 모르겠으므로 해시 테이블과 같은 성능이 필요한 경우 더 자세히 알아보고 싶을 수 있습니다. (편집 : Scripting.Dictionary는 내부적 으로 해시 테이블을 사용합니다 .)

Question 3

내가 사용했던 프란체스코 Balena의 해시 클래스 컬렉션 또는 사전에 완벽하게 적합하지 때 과거에 여러 번하고 난 그냥 해시 테이블이 필요했습니다.

Question 4

사전 개체 또는 컬렉션 개체를 사용해보십시오.

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

Question 5

자갑니다 ... 코드를 모듈에 복사하면 바로 사용할 수 있습니다.

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

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