Question

我试图创建一个宏，在该宏中我有一个具有相同值的excel电子表格，但行中的值不同，我希望它使用宏将其放在单个列中。例如；

A B TEST 1 TEST 2 TEST 3

结果：

A B TEST 1,2,3

Answer 1

说明： 1.行Set xRg = Range（“ D1”）中的D1表示结果将放置在单元格D1中。

否和xRes（1，1）=“ No”和xRes（1，2）=“ Combined Color”行中的合并颜色是串联列的标题。您可以根据需要更改它们。

按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

Answer 2

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

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

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

2 个答案: