VBA映射实现

我需要在VBA中实现良好的映射类。这是我的整数键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

一切ok，如果我插入千对键值。但是，如果50000，程序冻结。

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

来源

2014-12-27 glnix

你的实现的主要问题是操作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

参见：

来源

2014-12-28 09:38:48 xmojmr

VBA映射实现

回答

相关问题