Есть ли в VBA структура словаря?

Есть ли в VBA структура словаря? Как массив ключей<>?

Источник

11 ответов

Решение

Да.

Установите ссылку на среду выполнения сценариев MS ("среда выполнения сценариев Microsoft"). В соответствии с комментарием @regjo, перейдите в Tools->References и поставьте галочку для "Microsoft Scripting Runtime".

Окно ссылок

Создайте экземпляр словаря, используя код ниже:

Set dict = CreateObject("Scripting.Dictionary")

или же

Dim dict As New Scripting.Dictionary

Пример использования:

If Not dict.Exists(key) Then 
    dict.Add key, value
End If

Не забудьте установить словарь в Nothing когда вы закончили использовать его.

Set dict = Nothing
Источник

VBA имеет объект коллекции:

    Dim c As Collection
    Set c = New Collection
    c.Add "Data1", "Key1"
    c.Add "Data2", "Key2"
    c.Add "Data3", "Key3"
    'Insert data via key into cell A1
    Range("A1").Value = c.Item("Key2")

Collection Объект выполняет поиск по ключу, используя хеш, поэтому это быстро.

Вы можете использовать Contains() функция, чтобы проверить, содержит ли определенная коллекция ключ:

Public Function Contains(col As Collection, key As Variant) As Boolean
    On Error Resume Next
    col(key) ' Just try it. If it fails, Err.Number will be nonzero.
    Contains = (Err.Number = 0)
    Err.Clear
End Function

Изменить 24 июня 2015 года: короче Contains() благодаря @TWiStErRob.

Изменить 25 сентября 2015: добавлено Err.Clear() спасибо @scipilot.

Источник

VBA не имеет внутренней реализации словаря, но из VBA вы все еще можете использовать объект словаря из MS Scripting Runtime Library.

Dim d
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "aaa"
d.Add "b", "bbb"
d.Add "c", "ccc"

If d.Exists("c") Then
    MsgBox d("c")
End If
Источник

Дополнительный пример словаря, который полезен для сдерживания частоты встречаемости.

Вне цикла:

Dim dict As New Scripting.dictionary
Dim MyVar as String

Внутри цикла:

'dictionary
If dict.Exists(MyVar) Then
    dict.Item(MyVar) = dict.Item(MyVar) + 1 'increment
Else
    dict.Item(MyVar) = 1 'set as 1st occurence
End If

Чтобы проверить частоту:

Dim i As Integer
For i = 0 To dict.Count - 1 ' lower index 0 (instead of 1)
    Debug.Print dict.Items(i) & " " & dict.Keys(i)
Next i
Источник

Основываясь на ответе cjrh, мы можем создать функцию Contains, не требующую меток (я не люблю использовать метки).

Public Function Contains(Col As Collection, Key As String) As Boolean
    Contains = True
    On Error Resume Next
        err.Clear
        Col (Key)
        If err.Number <> 0 Then
            Contains = False
            err.Clear
        End If
    On Error GoTo 0
End Function

Для моего проекта я написал набор вспомогательных функций, чтобы сделать Collection вести себя больше как Dictionary, Это все еще позволяет рекурсивные коллекции. Вы заметите, что Key всегда стоит первым, потому что он был обязательным и имел больше смысла в моей реализации. Я также использовал только String ключи. Вы можете изменить его обратно, если хотите.

Задавать

Я переименовал это, чтобы установить, потому что это перезапишет старые значения.

Private Sub cSet(ByRef Col As Collection, Key As String, Item As Variant)
    If (cHas(Col, Key)) Then Col.Remove Key
    Col.Add Array(Key, Item), Key
End Sub

Получить

err вещи для объектов, так как вы будете передавать объекты с помощью set и переменные без. Я думаю, что вы можете просто проверить, если это объект, но я был вынужден на время.

Private Function cGet(ByRef Col As Collection, Key As String) As Variant
    If Not cHas(Col, Key) Then Exit Function
    On Error Resume Next
        err.Clear
        Set cGet = Col(Key)(1)
        If err.Number = 13 Then
            err.Clear
            cGet = Col(Key)(1)
        End If
    On Error GoTo 0
    If err.Number <> 0 Then Call err.raise(err.Number, err.Source, err.Description, err.HelpFile, err.HelpContext)
End Function

имеет

Причина этого поста...

Public Function cHas(Col As Collection, Key As String) As Boolean
    cHas = True
    On Error Resume Next
        err.Clear
        Col (Key)
        If err.Number <> 0 Then
            cHas = False
            err.Clear
        End If
    On Error GoTo 0
End Function

Удалить

Не бросает, если его не существует. Просто убедитесь, что он удален.

Private Sub cRemove(ByRef Col As Collection, Key As String)
    If cHas(Col, Key) Then Col.Remove Key
End Sub

Ключи

Получить массив ключей.

Private Function cKeys(ByRef Col As Collection) As String()
    Dim Initialized As Boolean
    Dim Keys() As String

    For Each Item In Col
        If Not Initialized Then
            ReDim Preserve Keys(0)
            Keys(UBound(Keys)) = Item(0)
            Initialized = True
        Else
            ReDim Preserve Keys(UBound(Keys) + 1)
            Keys(UBound(Keys)) = Item(0)
        End If
    Next Item

    cKeys = Keys
End Function
Источник

Все остальные уже упоминали об использовании версии scripting.runtime класса Dictionary. Если вы не можете использовать эту DLL, вы также можете использовать эту версию, просто добавьте ее в свой код.

https://github.com/VBA-tools/VBA-Dictionary/blob/master/Dictionary.cls

Это идентично версии Microsoft.

Источник

Кажется, что в скриптовом словаре времени исполнения есть ошибка, которая может испортить ваш дизайн на продвинутых этапах.

Если значение словаря является массивом, вы не можете обновить значения элементов, содержащихся в массиве, посредством ссылки на словарь.

Источник

Да. Для VB6, VBA (Excel) и VB.NET

Источник

Если по какой-либо причине вы не можете установить дополнительные функции в Excel или не хотите, вы также можете использовать массивы, по крайней мере, для простых задач. В качестве WhatIsCapital вы вводите название страны, а функция возвращает вам ее капитал.

Sub arrays()
Dim WhatIsCapital As String, Country As Array, Capital As Array, Answer As String

WhatIsCapital = "Sweden"

Country = Array("UK", "Sweden", "Germany", "France")
Capital = Array("London", "Stockholm", "Berlin", "Paris")

For i = 0 To 10
    If WhatIsCapital = Country(i) Then Answer = Capital(i)
Next i

Debug.Print Answer

End Sub
Источник

VBA может использовать словарную структуру Scripting.Runtime.

И его реализация на самом деле необычная - просто выполнив myDict(x) = y, проверяет, есть ли ключ xв словаре, а если его нет, то даже создает. Если он есть, он его использует.

И он не "кричит" и не "жалуется" на этот лишний шаг, выполняемый "под капотом". Конечно, вы можете явно проверить, существует ли ключ с Dictionary.Exists(key). Итак, эти 5 строк:

       If myDict.exists("B") Then
    myDict("B") = myDict("B") + i * 3
Else
    myDict.Add "B", i * 3
End If

такие же, как этот 1 лайнер - myDict("B") = myDict("B") + i * 3. Проверьте это:

       Sub TestMe()

    Dim myDict As Object, i As Long, myKey As Variant
    Set myDict = CreateObject("Scripting.Dictionary")
    
    For i = 1 To 3
        Debug.Print myDict.Exists("A")
        myDict("A") = myDict("A") + i
        myDict("B") = myDict("B") + 5
    Next i
    
    For Each myKey In myDict.keys
        Debug.Print myKey; myDict(myKey)
    Next myKey

End Sub

Источник

Вы можете получить доступ к неродному HashTableчерез System.Collections.HashTable.

Хеш-таблица

Представляет набор пар "ключ-значение", организованных на основе хэш-кода ключа.

Не уверен, что вы когда-нибудь захотите использовать это Scripting.Dictionaryно добавив сюда для полноты картины. Вы можете просмотреть методы, если есть интерес, например Clone, CopyTo

Пример:

      Option Explicit

Public Sub UsingHashTable()

    Dim h As Object
    Set h = CreateObject("System.Collections.HashTable")
   
    h.Add "A", 1
    ' h.Add "A", 1  ''<< Will throw duplicate key error
    h.Add "B", 2
    h("B") = 2
      
    Dim keys As mscorlib.IEnumerable 'Need to cast in order to enumerate  'https://stackoverflow.com/a/56705428/6241235
    
    Set keys = h.keys
    
    Dim k As Variant
    
    For Each k In keys
        Debug.Print k, h(k)                      'outputs the key and its associated value
    Next
    
End Sub

Этот ответ @MathieuGuindon дает много подробностей о HashTable, а также о том, почему необходимо использовать mscorlib.IEnumerable(ранняя ссылка на mscorlib) для перечисления пар ключ:значение.

Источник
Другие вопросы по тегам