1

Sub cdsr()
    Dim d, ar
    Set d = CreateObject("Scripting.Dictionary")
    ar = [a1].CurrentRegion'數(shù)組賦值
    For i = 2 To UBound(ar)'遍歷數(shù)組
        If Not d.exists(ar(i, 1)) Then'如果字典里不存在
            d(ar(i, 1)) = ar(i, 2)'放進(jìn)字典
        Else'如果存在,用逗號(hào)鏈接起來
                d(ar(i, 1)) = d(ar(i, 1)) & "，" & ar(i, 2)
        End If
    Next
'輸出字典數(shù)據(jù)
   [d2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub

沒去重結(jié)果

• 上面的代碼是沒有去重復(fù)的。

Sub cdsr()
    Dim d, ar
    Set d = CreateObject("Scripting.Dictionary")
    ar = [a1].CurrentRegion
    For i = 2 To UBound(ar)
        If Not d.exists(ar(i, 1)) Then
            d(ar(i, 1)) = ar(i, 2)
        Else
'判斷姓名是否重復(fù)，不重復(fù)就用逗號(hào)連接起來，instr函數(shù)用法自行百度
            If InStr(d(ar(i, 1)), ar(i, 2)) = 0 Then
                d(ar(i, 1)) = d(ar(i, 1)) & "，" & ar(i, 2)
            End If
        End If
    Next
    [d2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub

最終結(jié)果