获取两列数据并转换为字典的最简单方法是什么？

I have a worksheet with data in columns A and B.

我有一个包含A列和B列数据的工作表。

I am looking for a convenient way to take these columns and convert to dictionary where the cell in column A is the key and column B is the value, something like :

我正在寻找一种方便的方法来获取这些列并转换为字典，其中A列中的单元格是键，B列是值，如下所示：

Dim dict as Dictionary
Set dict = CreateDictFromColumns("SheetName", "A", "B")

NOTE: I am already referencing the scripting dll.

注意：我已经引用了脚本dll。

4 个解决方案

#1

You would need to loop, E.g.

你需要循环，例如。

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

This breaks on the first empty key value cell.

这打破了第一个空键值单元格。

#2

I think it'd be best form to pass two ranges to a create dictionary function. This allows for the ranges to be completely separate, even different workbooks. It also allows for a 1D range to be mapped to a 2D range as demonstrated below.

我认为将两个范围传递给创建字典函数是最好的形式。这允许范围完全分离，甚至不同的工作簿。它还允许将1D范围映射到2D范围，如下所示。

Alternatively, you could also pass two arrays of range values. That may be cleaner for 1D ranges, but would result in slightly more code for 2D mapping. Notice that range elements can be looped through left to right top to bottom by index. You can use Application.Transpose(Range("A1:A5")) to effectively run top to bottom left to right.

或者，您也可以传递两个范围值数组。这对于1D范围可能更清晰，但是会导致稍微更多的2D映射代码。请注意，范围元素可以通过索引从左到右从上到下循环。您可以使用Application.Transpose（Range（“A1：A5”））从左到右有效地从上到下运行。

Jagged Mapping

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

Side-By-Side (As Range)

If your target range is a single 2 column range side by side, you can simplify to passing a single range as shown below. Consequently, this also works for mapping every other element in a 1 dimensional range.

如果您的目标范围是并排的单个2列范围，则可以简化为传递单个范围，如下所示。因此，这也适用于在1维范围内映射每个其他元素。

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

Two Columns (As Array)

Lastly, as an example of passing arrays as arguments, you could do something like the following. However, the following code will only work given the OP's specific scenario of mapping two columns. As is, it won't handle mapping rows or alternating elements.

最后，作为将数组作为参数传递的示例，您可以执行以下操作。但是，以下代码仅在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

Use of Named Ranges

It may be convenient to used named ranges, in which case you can pass a Range as an argument likes this...

使用命名范围可能很方便，在这种情况下你可以传递一个Range作为参数喜欢这个...

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

#3

The best approach to take, is to populate a variant array with the data from the worksheet. You can then loop through the array, assigning the elements of the first array column as the dictionary key; the elements of the second array column can then be used as the value.

最好的方法是使用工作表中的数据填充变量数组。然后，您可以循环遍历数组，将第一个数组列的元素指定为字典键;然后可以将第二个数组列的元素用作值。

The lrow function is used to find the last populated row from column A - allowing the code to create a dynamically sized array and dictionary.

lrow函数用于查找A列中最后一个填充的行 - 允许代码创建动态大小的数组和字典。

To enable use of dictionaries within VBA, you will need to go to Tools -> References and then enable Microsoft Scripting Runtime.

要在VBA中启用字典，您需要转到工具 - >引用，然后启用Microsoft Scripting Runtime。

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

#4

This should do the trick :

这应该是诀窍：

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 Val, Key
        End If
    Next i
End With

test_leora = Dic
End Function