Karma Tablo/İlişkisel Dizi VBA'da

Question

VBA'da karma tablo veya ilişkisel dizinin nasıl oluşturulacağını açıklayan belgeleri bulamıyorum. Bu mümkün mü?

Bir makaleye link verebilir veya daha iyisi kod yazabilir misiniz?

Answer 1

Ben Microsoft komut dosyası çalışma zamanı kütüphanesinde bulunan Dictionary nesnesi, aradığınız düşünüyorum. (VBE'deki Araçlar ... Referanslar menüsünden projenize bir referans ekleyin.)

Bir varyantı sığabilecek herhangi bir basit değerle oldukça çalışır (Anahtarlar diziler olamaz ve yapmaya çalışılır) onları nesneler çok mantıklı değil aşağıda @Nile dan açıklama bakınız).:. ihtiyaçlarınız basittir ve sadece dize anahtarlarını istiyorsanız

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 

Ayrıca VBA koleksiyon nesnesi kullanabilirsiniz.

Gerçekten de herhangi bir şeyle ilgili karmaşalar yapıp yapmadığımı bilmiyorum, bu yüzden karmaşa benzer performansa ihtiyacınız varsa daha fazla kazmak isteyebilirsiniz. (DÜZENLEME: Scripting.Dictionary bir iç hash table kullanır.)

Answer 2

Sözlük Nesnesini veya Toplama Nesnesini kullanmayı deneyin.

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

Answer 3

Bir Koleksiyon veya Sözlük mükemmel bir uyum sağlamadığında ve sadece bir HashTable'a ihtiyaç duyduğumda, geçmişte birkaç kez Francesco Balena's HashTable class kullandım. İşte

Answer 4

biz sadece bir modüle kodu kopyalayıp ... go, bu VB kullanmak için

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 

kullanmaya hazır (A) Uygulama: ait

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