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

我有一个工作表，列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

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

lrow函数用于查找列A中最后一个已填充的行 – 允许代码创build一个dynamicresize的数组和字典。

要在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 

Answer 3

我认为将两个范围传递给创build字典函数是最好的forms。 这使得范围可以完全分开，甚至不同的工作簿。 它还允许将一维范围映射到2D范围，如下所示。

或者，您也可以传递两个范围值数组。 这对于一维范围来说可能更清晰，但会导致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