创建一个以组合键作为标识符的字典(VBA)

Question

我正在努力寻找一种方法来创建一个具有2列作为关键标识符的字典。我不能只用一个，因为它不是唯一的。每一行的命名和结束都是唯一的。

下面是一些代码

Dim LstRw As Long, Rng As Range, cell As Range, cell2 As Range
Dim Dict As Object

Set nameRng = Range(Range("A2"), Range("A2").End(xlDown))
Set operRng = Range(Range("B2"), Range("B2").End(xlDown))
Set saisieRng = Range(Range("C2"), Range("C2").End(xlDown))

Set Dict = CreateObject("Scripting.Dictionary")

LstRw = Cells(Rows.Count, "A").End(xlUp).Row

For Each cell In nameRng
For Each cell2 In operRng
Dict.Add cell.Value, cell2.Value
Next

Next

运行这个，我得到一个错误"键已经存在"但我不明白为什么。

提前感谢!

Answer 1

为了提取两列的唯一值

Sub testUniqueKeys()
Dim sh As Worksheet, lastR As Long, arr, i As Long, dict As Object

Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row

Set dict = CreateObject("Scripting.Dictionary")
arr = sh.Range("A2:C" & lastR).Value
For i = 1 To UBound(arr)
dict(arr(i, 1)) = vbNullString
dict(arr(i, 2)) = vbNullString
dict(arr(i, 3)) = vbNullString
Next i
Debug.Print Join(dict.Keys, "|") 'to visually see (in Immediate Window) the resulted keys
End Sub

如果您想从第三列中提取所有值在通过前两个键连接获得的字典键中，请尝试下一个适应的方法:

Sub testUniqueConcatKeys()
Dim sh As Worksheet, lastR As Long, arr, i As Long, dict As Object

Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row

Set dict = CreateObject("Scripting.Dictionary")
arr = sh.Range("A2:C" & lastR).Value
For i = 1 To UBound(arr)
If Not dict.Exists(arr(i, 1) & arr(i, 2)) Then
dict.Add arr(i, 1) & arr(i, 2), arr(i, 3)
Else
dict(arr(i, 1) & arr(i, 2)) = dict(arr(i, 1) & arr(i, 2)) & "|" & arr(i, 3)
End If
Next i
Debug.Print Join(dict.Keys, ":")
Debug.Print Join(dict.Items)
End Sub

在我编辑代码之前的另一个答案显示了类似的内容。所以，它应该被标记为第一个理解你想要什么的人。我的，显示所有的出现，如果是这样的话。

如果没有，请编辑你的问题，并尝试做我在我的评论中推荐的…

Answer 2

使用一个For Each循环，Offset:

For Each cell In nameRng
Dim key As String
key = cell.Value & "," & cell.Offset(,1).Value
Dim itm As Variant
itm = cell.Offset(,2).Value
Dict.Add key, itm
Next

如果列不相邻，则使用For...Next循环:

For i = 1 to nameRng.Count
Dim key As String
key = nameRng.Cells(i).Value & "," & operRng.Cells(i).Value

Dim itm As Variant
itm = saisieRng.Cells(i).Value
Dict.Add key, itm
Next