Excel宏用于组合列的单元格中的不同值

Question

我试图创建一个宏，我有这个excel电子表格连续相同的值，但列的值不同，我希望它使用宏将它放在一个列上。例如;

A      B
TEST   1
TEST   2
TEST   3

结果：

A      B
TEST   1,2,3

Answer 1

还有其他方法可以做到这一点，但这是一个非常简单的解决方案：

Sub consolidateValues()

    Dim sh As Worksheet
    Dim rw As Range
    Dim s As String
    Dim i As Integer

    Set sh = ThisWorkbook.Sheets("Sheet1")

    For Each rw In Intersect(sh.UsedRange, sh.Range("A:B")).Rows

        'Skip row 1 (assumed headers)
        If rw.Row <> 1 Then

            s = ""

            For i = sh.UsedRange.Rows.Count To rw.Row + 1 Step -1

                If rw.Cells(1, 1) = sh.Cells(i, 1) Then
                    s = sh.Cells(i, 2).Value & IIf(s = "", "", ",") & s
                    sh.Rows(i).Delete
                End If

            Next i

            If s <> "" Then rw.Cells(1, 2).Value = rw.Cells(1, 2).Value & "," & s

        End If

    Next rw

End Sub

Answer 2

注意：1。行中的D1设置xRg =范围（“D1”）表示结果将放在单元格D1中。

2. 行中的否和组合颜色xRes（1,1）=“否”和xRes（1,2）=“组合颜色”是连接列的标题。您可以根据需要更改它们。
3. 按F5键运行代码，然后您将获得指定范围内的连接结果。

    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