Как проще всего взять два столбца данных и преобразовать их в словарь?

Вам нужно будет выполнить цикл, например.

Function CreateDictFromColumns(sheet As String, keyCol As String, valCol As String) As Dictionary
    Set CreateDictFromColumns = New Dictionary
    Dim rng As Range: Set rng = Sheets(sheet).Range(keyCol & ":" & valCol)
    Dim i As Long
    Dim lastCol As Long '// for non-adjacent ("A:ZZ")
    lastCol = rng.Columns.Count
    For i = 1 To rng.Rows.Count
        If (rng(i, 1).Value = "") Then Exit Function
        CreateDictFromColumns.Add rng(i, 1).Value, rng(i, lastCol).Value
    Next
End Function

Это прерывается на первой пустой ячейке значения ключа.

Я думаю, что было бы лучше передать два диапазона функции создания словаря. Это позволяет диапазонам быть полностью отдельными, даже в разных книгах. Это также позволяет сопоставить диапазон 1D с диапазоном 2D, как показано ниже.

В качестве альтернативы вы также можете передать два массива значений диапазона. Это может быть чище для диапазонов 1D, но приведет к немного большему количеству кода для отображения 2D. Обратите внимание, что элементы диапазона могут проходить по циклу слева направо сверху вниз по индексу. Вы можете использовать Application.Transpose(Range("A1:A5")) для эффективного запуска сверху вниз слева направо.

Неровное сопоставление

Sub Test()
    RangeToDict Sheets(1).Range("A1:A5"), Sheets(2).Range("C1:E2")
End Sub

Function RangeToDict(ByVal KeyRng As Range, ByVal ValRng As Range) As Dictionary
    Set RangeToDict = New Dictionary
    For Each r In KeyRng
        vi = vi + 1
        'It may not be advisable to handle empty key values this way
        'The handling of empty values and #N/A/Error values 
        'Depends on your exact usage
        If r.Value2 <> "" Then
            RangeToDict.Add r.Value2, ValRng(vi)
            Debug.Print r.Value2 & ", " & ValRng(vi)
        End If
    Next
End Function

Рядом (как диапазон)

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

Sub Test()
    RangeToDict2 Range("A1:B5")
End Sub
Function RangeToDict2(ByVal R As Range) As Dictionary
    Set RangeToDict2 = New Dictionary
    i = 1
    Do Until i >= (R.Rows.Count * R.Columns.Count)
        RangeToDict2.Add R(i), R(i + 1)
        Debug.Print R(i) & ", " & R(i + 1)
        i = i + 2
    Loop
End Function

Два столбца (в виде массива)

Наконец, в качестве примера передачи массивов в качестве аргументов вы можете сделать что-то вроде следующего. Однако следующий код будет работать только с учетом конкретного сценария OP для сопоставления двух столбцов. Как есть, он не будет обрабатывать сопоставление строк или чередующихся элементов.

Sub Test()
    Dim Keys() As Variant: Keys = Range("E1:I1").Value2
    Dim Values() As Variant: Values = Range("E3:I3").Value2
    RangeToDict Keys, Values
End Sub
Function RangeToDict(Keys() As Variant, Values() As Variant) As Dictionary
    Set RangeToDict = New Dictionary
    For i = 1 To UBound(Keys)
        RangeToDict.Add Keys(i, 1), Values(i, 1)
        Debug.Print Keys(i, 1) & ", " & Values(i, 1)
    Next
End Function

Использование именованных диапазонов

Может быть удобно использовать именованные диапазоны, и в этом случае вы можете передать диапазон в качестве аргумента, подобного этому...

Sub Test()
    RangeToDict Names("Keys").RefersToRange, Names("Values").RefersToRange
End Sub

Лучший подход — заполнить вариантный массив данными из рабочего листа. Затем вы можете перебрать массив, назначив элементы первого столбца массива в качестве ключа словаря; затем элементы второго столбца массива могут использоваться в качестве значения.

Функция lrow используется для поиска последней заполненной строки из столбца A, что позволяет коду создавать массив и словарь с динамическим размером.

Чтобы включить использование словарей в VBA, вам нужно перейти в Инструменты -> Ссылки, а затем включить среду выполнения сценариев Microsoft.

Sub createDictionary()
    Dim dict As Scripting.Dictionary
    Dim arrData() As Variant
    Dim i as Long

    arrData = Range("A1", Cells(lrow(1), 2))
    set dict = new Scripting.Dictionary        

    For i = LBound(arrData, 1) To UBound(arrData, 1)
        dict(arrData(i, 1)) = arrData(i, 2)
    Next i
End Sub

Function lrow(ByVal colNum As Long) As Long
    lrow = Cells(Rows.Count, 1).End(xlUp).Row
End Function

Это должно помочь:

Public Function test_leora(SheetName As String, _
                            KeyColumn As String, _
                            ValColumn As String) _
                                    As Variant
Dim Dic, _
    Val As String, _
    Key As String, _
    Ws As Worksheet, _
    LastRow As Long

Set Ws = ThisWorkbook.Sheets(SheetName)
Set Dic = CreateObject("Scripting.Dictionary")

With Ws
    LastRow = .Range(KeyColumn & .Rows.Count).End(xlUp).Row
    For i = 1 To LastRow
        Val = .Cells(i, ValColumn)
        Key = .Cells(i, KeyColumn)
        If Dic.exists(Key) Then
        Else
            Dic.Add Key, Val
        End If
    Next i
End With

test_leora = Dic
End Function