VBA中的哈希表/关联数组

我似乎无法find解释如何在VBA中创build一个哈希表或关联数组的文档。 这甚至有可能吗？

你能链接到一篇文章或更好的，但张贴代码？

Answer 1

我想你正在寻找在Microsoft Scripting Runtime库中find的Dictionary对象。 （从VBE中的Tools … References菜单中添加对您的项目的引用。）

它几乎适用于任何可以适用于变体的简单值（Keys不能是数组，而试图使它们成为对象没有多大意义，请参阅下面的@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 

如果你的需求比较简单，你只需要string键，你也可以使用VBA集合对象。

我不知道是否实际上有任何东西散列，所以如果你需要散列表的性能，你可能想要进一步挖掘。 （编辑：Scripting.Dictionary内部使用哈希表 。）

Answer 2

过去，我曾经多次使用过Francesco Balena的HashTable类 ，当一个集合或字典不是一个完美的适合，我只需要一个HashTable。

Answer 3

尝试使用Dictionary对象或Collection对象。

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

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（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