[已解决]按条件汇总所有不重复项目，并将符合条件的所有对应的值合并到同一单元格内

我行我速2008

1111111111

我行我速2008

222222222

我行我速2008

3333333333

我行我速2008

向10楼学习了，同时解决第三列有空格及错误值问题。

Sub tt()
    Dim ar, r, d
    ar = Sheet1.UsedRange
    Set d = CreateObject("scripting.dictionary")
    For r = 1 To UBound(ar)
        If IsError(ar(r, 3)) Then ar(r, 3) = ""
        If Trim(ar(r, 3)) <> "/" And Trim(ar(r, 3)) <> "" Then
            If d.exists(ar(r, 1)) Then
                If InStr(d(ar(r, 1)), ar(r, 3)) = 0 Then d(ar(r, 1)) = d(ar(r, 1)) & "," & ar(r, 3)
            Else
                d(ar(r, 1)) = ar(r, 3)
            End If
        End If
    Next r
    [G4].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub
Sub clear()
    [g4:h100] = ""
End Sub