基于公共属性合并行并合并相邻单元格填充数据的Excel VBA需求

示例数据 #

完整VBA代码 #

Sub CombineDuplicatesAndMergeCells()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, startRow As Long
    Dim mergeText As String
    
    Set ws = ActiveSheet ' 可改为指定工作表，例：ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    startRow = 2 ' 假设表头在第1行，数据从第2行开始
    
    i = startRow
    Do While i <= lastRow
        mergeText = ws.Cells(i, "B").Value
        startRow = i
        
        ' 遍历同attribute的后续行，拼接description内容
        Do While i + 1 <= lastRow And ws.Cells(i + 1, "A").Value = ws.Cells(startRow, "A").Value
            mergeText = mergeText & vbCrLf & ws.Cells(i + 1, "B").Value ' 用换行分隔，可改为", "
            i = i + 1
        Loop
        
        ' 合并attribute列单元格并居中
        ws.Range(ws.Cells(startRow, "A"), ws.Cells(i, "A")).Merge
        ws.Range(ws.Cells(startRow, "A"), ws.Cells(i, "A")).VerticalAlignment = xlCenter
        
        ' 合并description列单元格，填入拼接后的内容并自动换行
        ws.Range(ws.Cells(startRow, "B"), ws.Cells(i, "B")).Merge
        ws.Cells(startRow, "B").Value = mergeText
        ws.Cells(startRow, "B").WrapText = True
        
        i = i + 1
    Loop
End Sub

代码说明 #

• 核心逻辑：按attribute列的连续重复值分组，拼接对应description列的内容，再合并对应行的单元格并填入拼接结果。
• 分隔符可自定义：把代码里的vbCrLf换成", "就能用逗号分隔内容。
• 格式设置：添加了垂直居中、自动换行，让合并后的单元格排版更清晰，不需要的话可直接删除对应行代码。

注意事项 #

1. 运行前务必备份数据，避免误操作。
2. 确保数据已按attribute列排序，非连续的重复行不会被合并；如果需要处理非连续数据，可在代码开头添加排序逻辑。
3. 根据实际表格调整列标识（"A"、"B"）和起始行（startRow）。

内容的提问来源于stack exchange，提问作者Rob