वीबीए

Question

में हैश टेबल/एसोसिएटिव ऐरे मुझे वीबीए में हैश टेबल या एसोसिएटिव सरणी बनाने का तरीका बताते हुए प्रलेखन नहीं मिल रहा है। क्या यह भी संभव है?

क्या आप किसी लेख या बेहतर से लिंक कर सकते हैं फिर भी कोड पोस्ट कर सकते हैं?

Answer 1

मुझे लगता है कि आप शब्दकोश वस्तु, माइक्रोसॉफ्ट स्क्रिप्टिंग रनटाइम लायब्रेरी में पाया के लिए देख रहे हैं। (टूल्स से अपने प्रोजेक्ट का संदर्भ जोड़ें ... वीबीई में संदर्भ मेनू।)

यह किसी भी साधारण मूल्य के साथ बहुत अधिक काम करता है जो एक संस्करण में फिट हो सकता है (कुंजी एरे नहीं हो सकती है, और बनाने की कोशिश कर रही है उन्हें वस्तुओं खास मतलब यह नहीं है कि नीचे @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 आंतरिक रूप से hash table का उपयोग करता है।)

Answer 2

शब्दकोश ऑब्जेक्ट या संग्रह ऑब्जेक्ट का उपयोग करने का प्रयास करें।

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

Answer 3

मैंने पिछले समय कई बार Francesco Balena's HashTable class का उपयोग किया था जब संग्रह या शब्दकोश एकदम सही फिट नहीं था और मुझे बस एक हैशटेबल की आवश्यकता थी।

Answer 4

ये हम चले ... बस एक मॉड्यूल के लिए कोड को कॉपी करें, यह

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 में उपयोग करने के लिए तैयार है (ए) अनुप्रयोग:

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