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

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

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

要在VBA中启用词典，您需要转到工具 - ＆gt;引用然后启用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

Answer 3

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

并排（作为范围）

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

Answer 4

这应该可以解决问题：

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

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

4 个答案:

锯齿状映射

并排（作为范围）

两列（作为数组）

使用命名范围