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

Question

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

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

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

注意:我已经引用了脚本dll.

Answer 1

你需要循环,例如

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

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

Answer 2

我认为最好是将两个范围传递给创建字典函数的形式。这允许范围完全分开，甚至是不同的工作簿。如下所示，它还允许将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

并排（作为范围）

如果目标范围是并排的单个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

两列（作为数组）

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

命名范围的使用

使用命名范围可能会很方便，在这种情况下，您可以将Range作为这样的参数传递...

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