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

Question

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

Answer 1

Да.

Установить ссылку на среду выполнения сценариев 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 

Answer 2

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.

Answer 3

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

Answer 4

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

вне цикла:

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

Answer 5

Основываясь на ответе 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

Answer 6

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

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

Answer 7

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

Answer 8

Если по какой-либо причине вы не можете установить дополнительные функции в 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

Answer 9

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

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

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