Хеш-таблица / ассоциативный массив в VBA

90

Кажется, я не могу найти документацию, объясняющую, как создать хеш-таблицу или ассоциативный массив в VBA. Это вообще возможно?

Можете ли вы дать ссылку на статью или еще лучше опубликовать код?

Тайлер
источник
возможный дубликат. Есть ли в VBA структура словаря?
mmmmmm 04
Возможный дубликат словарной структуры VBA?
inetphantom

Ответы:

112

Я думаю, вы ищете объект Dictionary, который можно найти в библиотеке Microsoft Scripting Runtime. (Добавьте ссылку на свой проект из меню Инструменты ... Ссылки в VBE.)

Это в значительной степени работает с любым простым значением, которое может соответствовать варианту (ключи не могут быть массивами, и пытаться сделать их объектами не имеет большого смысла. См. Комментарий от @Nile ниже.):

Dim d As dictionary
Set d = New dictionary

d("x") = 42
d(42) = "forty-two"
d(CVErr(xlErrValue)) = "Excel #VALUE!"
Set d(101) = New Collection

Вы также можете использовать объект VBA Collection, если ваши потребности проще и вам нужны только строковые ключи.

Я не знаю, есть ли на самом деле хеши для чего-либо, поэтому вы можете копнуть дальше, если вам нужна производительность, подобная хеш-таблице. (EDIT: Scripting.Dictionary действительно использует хеш-таблицу внутри.)

jtolle
источник
да, словарь - это ответ. Я тоже нашел ответ на этом сайте. stackoverflow.com/questions/915317/…
user158017
2
Это довольно хороший ответ: но ключи никогда не являются объектами - на самом деле происходит то, что свойство объекта по умолчанию преобразуется как строка и используется в качестве ключа. Это не сработает, если для объекта не определено свойство по умолчанию (обычно «имя»).
Найджел Хеффернан
@ Нил, спасибо. Я вижу, что вы действительно правы. Также похоже, что если у объекта нет свойства по умолчанию, то соответствующий ключ словаря - Empty. Я соответственно отредактировал ответ.
jtolle
Здесь объясняется несколько структур данных - analystcave.com/… В этом посте показано, как использовать хэш-таблицы .NEXT в Excel VBA- stackoverflow.com/questions/8677949/…
johny why
опечатка выше ссылки: .NET, а не .NEXT.
johny why
7

Попробуйте использовать объект словаря или объект коллекции.

http://visualbasic.ittoolbox.com/documents/dictionary-object-vs-collection-object-12196

Дискотека
источник
1
Данная ссылка больше не работает. Содержимое, каким оно было на момент публикации, можно посмотреть здесь: web.archive.org/web/20090729034340/http://…
Paul van Leeuwen
6

Итак ... просто скопируйте код в модуль, он готов к использованию

Private Type hashtable
    key As Variant
    value As Variant
End Type

Private GetErrMsg As String

Private Function CreateHashTable(htable() As hashtable) As Boolean
    GetErrMsg = ""
    On Error GoTo CreateErr
        ReDim htable(0)
        CreateHashTable = True
    Exit Function

CreateErr:
    CreateHashTable = False
    GetErrMsg = Err.Description
End Function

Private Function AddValue(htable() As hashtable, key As Variant, value As Variant) As Long
    GetErrMsg = ""
    On Error GoTo AddErr
        Dim idx As Long
        idx = UBound(htable) + 1

        Dim htVal As hashtable
        htVal.key = key
        htVal.value = value

        Dim i As Long
        For i = 1 To UBound(htable)
            If htable(i).key = key Then Err.Raise 9999, , "Key [" & CStr(key) & "] is not unique"
        Next i

        ReDim Preserve htable(idx)

        htable(idx) = htVal
        AddValue = idx
    Exit Function

AddErr:
    AddValue = 0
    GetErrMsg = Err.Description
End Function

Private Function RemoveValue(htable() As hashtable, key As Variant) As Boolean
    GetErrMsg = ""
    On Error GoTo RemoveErr

        Dim i As Long, idx As Long
        Dim htTemp() As hashtable
        idx = 0

        For i = 1 To UBound(htable)
            If htable(i).key <> key And IsEmpty(htable(i).key) = False Then
                ReDim Preserve htTemp(idx)
                AddValue htTemp, htable(i).key, htable(i).value
                idx = idx + 1
            End If
        Next i

        If UBound(htable) = UBound(htTemp) Then Err.Raise 9998, , "Key [" & CStr(key) & "] not found"

        htable = htTemp
        RemoveValue = True
    Exit Function

RemoveErr:
    RemoveValue = False
    GetErrMsg = Err.Description
End Function

Private Function GetValue(htable() As hashtable, key As Variant) As Variant
    GetErrMsg = ""
    On Error GoTo GetValueErr
        Dim found As Boolean
        found = False

        For i = 1 To UBound(htable)
            If htable(i).key = key And IsEmpty(htable(i).key) = False Then
                GetValue = htable(i).value
                Exit Function
            End If
        Next i
        Err.Raise 9997, , "Key [" & CStr(key) & "] not found"

    Exit Function

GetValueErr:
    GetValue = ""
    GetErrMsg = Err.Description
End Function

Private Function GetValueCount(htable() As hashtable) As Long
    GetErrMsg = ""
    On Error GoTo GetValueCountErr
        GetValueCount = UBound(htable)
    Exit Function

GetValueCountErr:
    GetValueCount = 0
    GetErrMsg = Err.Description
End Function

Для использования в приложении VB (A):

Public Sub Test()
    Dim hashtbl() As hashtable
    Debug.Print "Create Hashtable: " & CreateHashTable(hashtbl)
    Debug.Print ""
    Debug.Print "ID Test   Add V1: " & AddValue(hashtbl, "Hallo_0", "Testwert 0")
    Debug.Print "ID Test   Add V2: " & AddValue(hashtbl, "Hallo_0", "Testwert 0")
    Debug.Print "ID Test 1 Add V1: " & AddValue(hashtbl, "Hallo.1", "Testwert 1")
    Debug.Print "ID Test 2 Add V1: " & AddValue(hashtbl, "Hallo-2", "Testwert 2")
    Debug.Print "ID Test 3 Add V1: " & AddValue(hashtbl, "Hallo 3", "Testwert 3")
    Debug.Print ""
    Debug.Print "Test 1 Removed V1: " & RemoveValue(hashtbl, "Hallo_1")
    Debug.Print "Test 1 Removed V2: " & RemoveValue(hashtbl, "Hallo_1")
    Debug.Print "Test 2 Removed V1: " & RemoveValue(hashtbl, "Hallo-2")
    Debug.Print ""
    Debug.Print "Value Test 3: " & CStr(GetValue(hashtbl, "Hallo 3"))
    Debug.Print "Value Test 1: " & CStr(GetValue(hashtbl, "Hallo_1"))
    Debug.Print ""
    Debug.Print "Hashtable Content:"

    For i = 1 To UBound(hashtbl)
        Debug.Print CStr(i) & ": " & CStr(hashtbl(i).key) & " - " & CStr(hashtbl(i).value)
    Next i

    Debug.Print ""
    Debug.Print "Count: " & CStr(GetValueCount(hashtbl))
End Sub
Стефан0410
источник
18
Я не собираюсь понижать голос нового пользователя, публикующего код, но обычно вызов чего-то «хеш-таблица» подразумевает, что основная реализация на самом деле является хеш-таблицей! У вас есть ассоциативный массив, реализованный с помощью обычного массива и линейного поиска. Смотрите здесь разницу: en.wikipedia.org/wiki/Hash_table
jtolle
7
Конечно. Смысл хеш-таблицы заключается в том, что «хеширование» ключа приводит к расположению его значения в базовом хранилище (или, по крайней мере, достаточно близко, в случае разрешенных повторяющихся ключей), что устраняет необходимость в потенциально дорогостоящем поиске.
Cor_Blimey
4
Слишком медленно для больших хэш-таблиц. Добавление 17 000 записей занимает более 15 секунд. Я могу добавить 500 000 менее чем за 6 секунд, используя словарь. 500000 менее чем за 3 секунды с использованием хеш-таблицы mscorlib.
Кристофер Томас Никодемус