VBA地图实现

Question

我需要在 VBA 中实现良好的地图类。 这是我对整数键的实现

盒子类：

Private key As Long 'Key, only positive digit
Private value As String 'Value, only 

'Value getter
Public Function GetValue() As String
    GetValue = value
End Function

'Value setter
Public Function setValue(pValue As String)
    value = pValue
End Function

'Ket setter
Public Function setKey(pKey As Long)
    Key = pKey
End Function

'Key getter
Public Function GetKey() As Long
    GetKey = Key
End Function

Private Sub Class_Initialize()

End Sub

Private Sub Class_Terminate()

End Sub

地图类：

Private boxCollection As Collection

'Init
Private Sub Class_Initialize()
    Set boxCollection = New Collection
End Sub

'Destroy
Private Sub Class_Terminate()
    Set boxCollection = Nothing
End Sub

'Add element(Box) to collection
Public Function Add(Key As Long, value As String)
    If (Key > 0) And (containsKey(Key) Is Nothing) Then
    Dim aBox As New Box
    With aBox
       .setKey (Key)
       .setValue (value)
    End With
    boxCollection.Add aBox
    Else
       MsgBox ("В словаре уже содержится элемент с ключем " + CStr(Key))
    End If
End Function

'Get key by value or -1
Public Function GetKey(value As String) As Long
    Dim gkBox As Box
    Set gkBox = containsValue(value)
    If gkBox Is Nothing Then
        GetKey = -1
    Else
        GetKey = gkBox.GetKey
    End If
End Function

'Get value by key or message
Public Function GetValue(Key As Long) As String
    Dim gvBox As Box
    Set gvBox = containsKey(Key)
    If gvBox Is Nothing Then
        MsgBox ("Key " + CStr(Key) + " dont exist")
    Else
        GetValue = gvBox.GetValue
    End If
End Function

'Remove element from collection
Public Function Remove(Key As Long)
    Dim index As Long
    index = getIndex(Key)
    If index > 0 Then
        boxCollection.Remove (index)
    End If
End Function


'Get count of element in collection
Public Function GetCount() As Long
    GetCount = boxCollection.Count
End Function

'Get object by key
Private Function containsKey(Key As Long) As Box
    If boxCollection.Count > 0 Then
           Dim i As Long
           For i = 1 To boxCollection.Count
             Dim fBox As Box
             Set fBox = boxCollection.Item(i)
             If fBox.GetKey = Key Then Set containsKey = fBox
          Next i
       End If
End Function

'Get object by value
Private Function containsValue(value As String) As Box
       If boxCollection.Count > 0 Then
           Dim i As Long
           For i = 1 To boxCollection.Count
             Dim fBox As Box
             Set fBox = boxCollection.Item(i)
             If fBox.GetValue = value Then Set containsValue = fBox
          Next i
       End If
End Function

'Get element index by key
Private Function getIndex(Key As Long) As Long
    getIndex = -1
    If boxCollection.Count > 0 Then
           For i = 1 To boxCollection.Count
             Dim fBox As Box
             Set fBox = boxCollection.Item(i)
             If fBox.GetKey = Key Then getIndex = i
          Next i
       End If
End Function

如果我插入 1000 对键值对，一切正常。但是如果是 50000，程序就会冻结。

我该如何解决这个问题？或者也许有更好的解决方案？

Answer 1

您的实现的主要问题是操作containsKey 非常昂贵（O(n) complex），并且在每次插入时都会调用它，即使它“知道”会产生什么结果，它也永远不会中断。

这可能会有所帮助：

...
If fBox.GetKey = Key Then
    Set containsKey = fBox
    Exit Function
End If
...

为了降低containsKey 的复杂性，典型的做法是

• 保持键排序，以便您可以使用binary search 而不是线性搜索
• 将密钥保存在树中或hashed buckets

最直接的做法是使用Collection 的内置（希望已优化）功能通过键存储/检索项目。

商店：

...
boxCollection.Add Item := aBox, Key := CStr(Key)
...

检索（未测试，基于this answer）：

Private Function containsKey(Key As Long) As Box
    On Error GoTo err
        Set containsKey = boxCollection.Item(CStr(Key))
        Exit Function
    err:
        Set containsKey = Nothing
End Function

另见：

• MSDN: How to: Add, Delete, and Retrieve Items of a Collection (Visual Basic)
• Stack Overflow: Does VBA have Dictionary Structure?
• Newton Excel Bach: Arrays vs Collections vs Dictionary Objects (and Dictionary help)