VBA地图实施

时间:2014-12-27 17:41:17

标签: excel vba excel-vba dictionary collections

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

Box class:

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,程序会冻结。

我如何解决这个问题?或者可能有更好的解决方案?

1 个答案:

答案 0 :(得分:2)

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

这可能会有所帮助:

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

为了降低containsKey复杂性,典型的事情将是

最直接的做法是使用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

另见: