44、[VBA入门到放弃笔记] 字典联合数据（Textjoin）

1

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'如果存在,用逗号链接起来
                d(ar(i, 1)) = d(ar(i, 1)) & "，" & ar(i, 2)
        End If
    Next
'输出字典数据
   [d2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub

没去重结果

• 上面的代码是没有去重复的。

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
'判断姓名是否重复，不重复就用逗号连接起来，instr函数用法自行百度
            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

最终结果