Словарь VBA не присваивает значение ключу

Question

Я создал функцию getField, которая просматривает второй столбец и третий столбец электронной таблицы и возвращает словарь, ключами которого являются второй столбец, а значениями - третий. Функция принимает строку, которая является именем поля, которое ищется, но сейчас я не могу присвоить значение ключу. Вот строка, на которую я ссылаюсь, которая в настоящее время работает, но значение пусто, моя попытка присвоить значение не удалась, поэтому я поместил ее в комментарии, чтобы показать вам все, что я пытался. If InStr(data(r, 1), fieldName) > 0 Then dict(data(r, 1)) = Empty 'dict(value(r, 1))

Вот остаток кода:

Public Function getField(fieldName As String)

    Dim data(), dict As Object, r As Long
    Set dict = CreateObject("Scripting.Dictionary")

    data = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns(2).value
    value = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns(3).value

    For r = 1 To UBound(data)

        If InStr(data(r, 1), fieldName) > 0 Then dict(data(r, 1)) = Empty 'dict(value(r, 1))
     Next

    data = WorksheetFunction.Transpose(dict.Keys())

    Set getField = dict

End Function

Answer 1

Представленный код показывает, что вы не помогаете себе.

Существует необъявленная переменная Value. Для функции не объявлен тип возвращаемого значения.

Поэтому, пожалуйста, вставьте Option в явном виде в начале каждого модуля, а затем установите дополнение Fantasti c RubberDuck и посмотрите на проверки кода. Эти два действия избавят вас от боли при написании макросов VBA.

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

dict(data(r, 1)) = dict(value(r, 1))

где dict (значение (r, 1)) используется со значением (r, 1) в качестве ключа для значения словаря. Это означает, что при первом использовании этой конструкции произойдет сбой, поскольку в словаре нет данных, и поэтому dict (значение (r, 1)) пытается получить доступ к несуществующим данным.

Правильная структура

dict(data(r,1) = value(r,1)

, где значение, помещаемое в словарь в dict (data (r, 1)), является значением, хранящимся в значении варианта массива в Index (r, 1).

Для scripting.dictionary существует два способа добавления данных

Dict.add Key, Value

и

Dict(Key)=Value

Первый из вышеперечисленных завершится ошибкой, если ключ уже присутствует в словаре .
Второй метод - это обоюдоострый меч, так как он создает запись для ключа, если ключ отсутствует в словаре, а затем присваивает значение. ОДНАКО, если ключ уже существует, он перезапишет любое существующее значение, назначенное ключу. Это может или не может быть поведение, которое требуется.

Для метода добавления мы можем избежать ошибки, возникающей для дубликатов ключей, проверяя наличие ключа в словаре с помощью метода «существующие».

If not dict.exists(key) then
    dict.add key,value
Else
    ' what ever action is needed in the case of duplicate keys
End if

Код, представленный OP, обновляется и представлен ниже.

Public Function getField(fieldName As String) as Scripting.Dictioanry

    Dim myKeys As Variant   'Formerly data
    myKeys = Excel.WorksheetFunction.Transpose(ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns(2).Value)

    Dim myItems As Variant  'Formerly value but not declared
    myItems = Excel.WorksheetFunction.Transpose(ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns(3).Value)

    Dim myRow As Long
    Dim myDict As Scripting.Dictionary
    Set myDict = New Scripting.Dictionary
    For myRow = 0 To UBound(myKeys)

        If Not dict.Exists(myKeys(myRow)) Then

            dict.Add myKeys(myRow), myItems(myRow)

        Else

            Debug.Print "Duplicate Key found: ", myKeys(myRow)

        End If

     Next

    ' No longer required
    ' data = WorksheetFunction.Transpose(dict.Keys())

    Set getField = dict

End Function

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

Public Function getField(fieldName As String) As Scripting.Dictioanry

    Dim myKeys As Variant   'Formerly data
    myKeys = Excel.WorksheetFunction.Transpose(ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns(2).Value)

    Dim myItems As Variant  'Formerly value but not declared
    myItems = Excel.WorksheetFunction.Transpose(ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns(3).Value)

    Dim myRow As Long
    Dim myDict As Scripting.Dictionary
    Set myDict = New Scripting.Dictionary
    For myRow = 0 To UBound(myKeys)

        If Not dict.Exists(myKeys(myRow)) Then

            ' add a new dictionary as the value for the key
            dict.Add myKeys(myRow), New Scripting.Dictionary

        End If

        ' now add the value to the dictionary seleted by the key
        ' we just use the current size of the sub dictionary as the index (key)
        ' for the value
        With dict.Item(myKeys(myRow))

            .Add .Count, myItem(myRow)

        End With

     Next

    Set getField = myDict

End Function

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

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

myValue = dict.item(key).item(index)

Где Item - элемент по умолчанию, используемый для доступа к значениям словаря (который обычно скрыт), например. Выше можно написать, менее интуитивно, как

myValue = myDict(key)(index)