Реализация 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 

Все нормально, если я вставляю значение ключа 1000 пар. Но если 50000, программа замерзает.

Как я могу решить эту проблему? Или, может быть, более лучшее решение?

    Основная проблема с вашей реализацией заключается в том, что операция 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) ... 

    Получить (не проверено, на основе этого ответа ):

     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: Как добавить, удалить и получить элементы коллекции (Visual Basic)
    • Переполнение стека: имеет ли VBA структуру словаря?
    • Newton Excel Bach: массивы против коллекций против объектов словаря (и справки словаря)
    Interesting Posts

    скопировать столбец в отфильтрованном диапазоне в другой столбец, частично правильно, частично иррационально

    Экспорт комментариев из Excel

    Работает с максимальным количеством вложенных операторов if

    Почему мое условное форматирование не работает?

    Как сравнить каждую вторую ячейку столбца с определенным значением?

    Альтернатива activecell копировать и вставлять

    Строка первой ячейки с текстом, поиск снизу

    Элементы слияния диапазона Excel VBA и смещение

    При использовании косвенной функции он не перемещает данные вниз

    Самый быстрый способ получить диапазон строк Excel

    Макрос Excel vba для вставки строк только правильно работает на первом листе

    Формула Excel IF / AND, использующая таблицу из Access

    Excel 2013 – проблема при закрытии нескольких книг, если одна книга скрыта

    Сравнение строк с массивом Item и String с VBA в Excel

    Excel Upload, дающий мне чистый лист

    Давайте будем гением компьютера.