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

d8tt03nd  于 2022-12-01  发布在  其他
关注(0)|答案(2)|浏览(206)

我正在努力寻找一种方法来创建一个有两列作为关键字标识符的字典。我不能只使用一列,因为它不是唯一的。一行的nameRng和operRng是唯一的。
下面是一些代码

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

运行这个程序,我得到一个错误“键已经存在”,但我不明白为什么。
提前感谢!

2lpgd968

2lpgd9681#

使用一个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
lndjwyie

lndjwyie2#

为了提取两列的唯一值,请使用下面的方法:

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

在我编辑代码之前的另一个答案也显示了类似的内容。所以,它应该被标记为第一个理解你想要什么的答案。我的答案显示了所有出现的情况,如果是这样的话。
如果两个变体都不是,请编辑你的问题,试着做我在评论中推荐的事情...

相关问题