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
5
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
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
2
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
0
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
#1
5
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
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
2
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
0
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