如何利用VBA将俩列一对多，多对一数据串联起来进行分组

zopey

Sub 按钮1_Click()
Range("c2:c65536").ClearContents
Dim d As Object, d2 As Object, ar, k
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
ar = Range("a2:c" & [a65536].End(3).Row).Value

For i = 1 To UBound(ar)
    If d.exists(ar(i, 1)) Then
        If d.exists(ar(i, 2)) Then
           If d(ar(i, 1)) = d(ar(i, 2)) Then
              ar(i, 3) = d(ar(i, 1))
           ElseIf d(ar(i, 1)) < d(ar(i, 2)) Then
              ar(i, 3) = d(ar(i, 1))
              d2(d(ar(i, 2))) = d(ar(i, 1))
           Else
              ar(i, 3) = d(ar(i, 2))
              d2(d(ar(i, 1))) = d(ar(i, 2))
           End If
        Else
           ar(i, 3) = d(ar(i, 1))
           d(ar(i, 2)) = ar(i, 3)
        End If
    ElseIf d.exists(ar(i, 2)) Then
        ar(i, 3) = d(ar(i, 2))
        d(ar(i, 1)) = ar(i, 3)
    Else
        k = k + 1
        ar(i, 3) = k
        d(ar(i, 1)) = ar(i, 3)
        d(ar(i, 2)) = ar(i, 3)
    End If
Next

For i = 1 To UBound(ar)
    If d2.exists(ar(i, 3)) Then ar(i, 3) = d2(ar(i, 3))
Next

[a2].Resize(UBound(ar), 3) = ar
End Sub