如何使用VBA在Excel中同时连接多列

Question

当我们只处理一列时，我知道如何连接。

例子：

Number Color
1      blue
1      red
1      pink
2      yelow
2      blue
3      red

结果：

Number Color
1      blue, red, pink
2      Yellow, blue
3      red

---

这是我正在使用的代码，它有效：

Sub ConcatenateCellsIfSameValues()
    Dim xCol As New Collection
    Dim xSrc As Variant
    Dim xRes() As Variant
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    xSrc = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    Set xRg = Range("D1")
    On Error Resume Next
    For I = 2 To UBound(xSrc)
        xCol.Add xSrc(I, 1), TypeName(xSrc(I, 1)) & CStr(xSrc(I, 1))
    Next I
    On Error GoTo 0
    ReDim xRes(1 To xCol.Count + 1, 1 To 2)
    xRes(1, 1) = "No"
    xRes(1, 2) = "Combined Color"
    For I = 1 To xCol.Count
        xRes(I + 1, 1) = xCol(I)
        For J = 2 To UBound(xSrc)
            If xSrc(J, 1) = xRes(I + 1, 1) Then
                xRes(I + 1, 2) = xRes(I + 1, 2) & ", " & xSrc(J, 2)
            End If
        Next J
        xRes(I + 1, 2) = Mid(xRes(I + 1, 2), 2)
    Next I
    Set xRg = xRg.Resize(UBound(xRes, 1), UBound(xRes, 2))
    xRg.NumberFormat = "@"
    xRg = xRes
    xRg.EntireColumn.AutoFit
End Sub

---

但是，我想连接这样的东西：

像这样：

带日期的附加示例：

Answer 1

以下是我将如何处理这个问题，使用Dictionary ，在我的例子中是Late Binding ：

Sub Test()

Dim lr As Long, x As Long
Dim arr As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1

    'Get last used row
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row

    'Get array
    arr = .Range("A2:C" & lr).Value

    'Loop through array
    For x = LBound(arr) To UBound(arr)
        If dict.Exists(arr(x, 1) & "|" & arr(x, 2)) Then
            dict(arr(x, 1) & "|" & arr(x, 2)) = Join(Array(dict(arr(x, 1) & "|" & arr(x, 2)), arr(x, 3)), ", ")
        Else
            dict(arr(x, 1) & "|" & arr(x, 2)) = arr(x, 3)
        End If
    Next x

    'Loop through dictionary
    For x = 0 To dict.Count - 1
        .Cells(x + 2, 4).Resize(, 2).Value = Split(dict.keys()(x), "|")
        .Cells(x + 2, 6).Value = dict.items()(x)
    Next x

End With

End Sub