Как добавить несколько ключей и значений в словарь одновременно?

Question

Я пытаюсь добавить столбец в качестве ключа и столбец справа от него в качестве значения.

Могу ли я сделать это без al oop?

Я пытался:

analystDict.Add Key:=refWS.Range("A2:A21"), Item:=refWS.Range("B2:B21")

Когда я пытаюсь Debug.Print, я получаю ошибку несоответствия типов:

For Each x In analystDict.Keys
    Debug.Print x, analystDict(x)
Next x

Answer 1

Вы используете ярлык, который не разрешен; Dictionary.Add реализован так, что он ожидает одну пару ключ / значение и добавляет один элемент в словарь. Если вам нужно добавить несколько элементов, вам нужно несколько вызовов для Dictionary.Add - нет никакого способа обойти это.

Ярлык, который будет разрешен, хотя будет просто захватывать значения в любом 2-столбце Range и превратить , что , в словарь, вместо того, чтобы брать любые случайные два массива, которые могут иметь или не иметь одинаковый размер.

Создать функцию, которая принимает 2D массив и превращает его в словарь, обрабатывая первый столбец как уникальные ключи, а второй столбец как значения.

Public Function ToDictionary(ByVal keyValuePairs As Variant) As Scripting.Dictionary
    If Not IsArray(keyValuePairs) Then Err.Raise 5
    If GetDimensions(keyValuePairs) <> 2 Then Err.Raise 5 'see https://stackoverflow.com/q/6901991/1188513

    Dim result As Scripting.Dictionary
    Set result = New Scripting.Dictionary

    Const KEYCOL = 1, VALUECOL = 2

    Dim i As Long
    For i = LBound(keyValuePairs, KEYCOL) To UBound(keyValuePairs, KEYCOL)
        If result.Exists(keyValuePairs(i, KEYCOL)) Then Err.Raise 457
        result.Add Key:=keyValuePairs(i, KEYCOL), Item:=keyValuePairs(i, VALUECOL)
    Next

    Set ToDictionary = result
End Function

Теперь вы можете превратить любой 2-столбец Range в Dictionary как this:

Dim things As Scripting.Dictionary
Set things = ToDictionary(Sheet1.Range("A2:B21").Value)

Обратите внимание, что Range.Value дает основанный на 1 массив 2D Variant всякий раз, когда он ссылается на несколько ячеек.

Answer 2

Вы не можете сделать это в VBA без написания вспомогательной функции.

Option Explicit

Public Sub AddTest()
    Dim analystDict As Scripting.Dictionary
    Set analystDict = New Scripting.Dictionary

    Dim refWS As Worksheet
    Set refWS = ActiveSheet

    AddToDictionary _
        analystDict, _
        Application.WorksheetFunction.Transpose(refWS.Range("A2:A21").Value), _
        Application.WorksheetFunction.Transpose(refWS.Range("B2:B21").Value)

End Sub

Public Sub AddToDictionary(ByRef ipDict As Scripting.Dictionary, ByVal ipKeys As Variant, ByVal ipValues As Variant)

    If UBound(ipKeys) <> UBound(ipValues) Then

        MsgBox "Arrays are not the same size"
        Exit Function

    End If

    Dim myIndex As Long
    For myIndex = LBound(ipKeys) To UBound(ipKeys)

        ipDict.Add ipKeys(myIndex), ipValues(myIndex)

    Next

End Function