Excel VBA字典-如何获取单元格中重复键的项目值？

Question

我正在尝试找到如何使用 Dictionary 删除重复值并连接单元格中的项目值的方法。

下面的代码正在做我想象的事情，但我可以在即时窗口中看到它（Debug.Print dict(People)。

字典 Keys(People) 的重复值的项目 (ID) 用逗号连接，但我不知道如何将这些项目提取到单元格。

所以 VBA 的想法是查找重复值并连接 ID 值并删除重复项。

谢谢！

Option Explicit

Sub DictionaryTest()
    
    Dim dict As Scripting.Dictionary
    Dim rowCount As Long
    Dim People As String
    Dim ID As Integer
    Dim item As Variant
    
    Set dict = New Scripting.Dictionary
    
    rowCount = Cells(Rows.Count, "E").End(xlUp).Row
    
    'Debug.Print rowCount
    
    Do While rowCount > 1
    
        People = Sheet2.Cells(rowCount, "E").Value
        ID = Sheet2.Cells(rowCount, "D").Value
        
        If dict.Exists(People) Then
            'Sheet2.Rows(rowCount).EntireRow.Delete
            
        Else
            dict.Add People, ID
        End If
        
        rowCount = rowCount - 1
        
    Loop
 
End Sub

Answer 1

请试试这个改编的代码：

Sub DictionaryTest()
    Dim dict As New Scripting.Dictionary
    Dim rowCount As Long, i As Long
    Dim People As String
    Dim ID As Integer
    Dim sh As Worksheet
    
    Set sh = Sheet2
    rowCount = sh.cells(Rows.count, "D").End(xlUp).Row

    For i = 2 To rowCount
        People = sh.cells(i, "D").Value
        ID = sh.cells(i, "C").Value
        
        If dict.Exists(People) Then
           dict(People) = dict(People) & "," & ID
        Else
            dict.Add People, ID
        End If
    Next i
    sh.Range("F2").Resize(dict.count).Value = WorksheetFunction.Transpose(dict.Items)
    sh.Range("G2").Resize(dict.count).Value = WorksheetFunction.Transpose(dict.Keys)
End Sub