Excel VBA宏开发需求：按AssetID合并多行文本数据

思路1：按非空AssetID循环处理合并 #

直接提取所有非空的唯一AssetID，逐个遍历对应的行，合并各列非空文本到首行，最后删除冗余行。

Sub MergeByAssetIDDirectly()
    Dim ws As Worksheet
    Dim lastRow As Long, colCount As Long
    Dim assetIDs As Collection
    Dim cell As Range, assetID As Variant
    Dim mergeRow As Long, i As Long, j As Long
    Dim mergedText As String
    
    Set ws = ActiveSheet
    lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row ' 获取数据最后一行
    colCount = ws.UsedRange.Columns.Count ' 获取总列数
    Set assetIDs = New Collection
    
    ' 收集所有非空的唯一AssetID
    On Error Resume Next
    For Each cell In ws.Range("A2:A" & lastRow) ' 假设AssetID在A列，第1行为表头
        If cell.Value <> "" Then
            assetIDs.Add cell.Value, Key:=CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    ' 遍历每个AssetID，合并对应行数据
    For Each assetID In assetIDs
        ' 找到当前AssetID的首行
        mergeRow = ws.Range("A:A").Find(What:=assetID, LookIn:=xlValues, LookAt:=xlWhole).Row
        ' 遍历后续行，合并数据
        i = mergeRow + 1
        Do While i <= lastRow
            If ws.Cells(i, "A").Value = "" Or ws.Cells(i, "A").Value = assetID Then
                ' 遍历每一列（从第2列开始，跳过AssetID列）
                For j = 2 To colCount
                    mergedText = ws.Cells(mergeRow, j).Value
                    ' 跳过空值，用换行合并
                    If ws.Cells(i, j).Value <> "" Then
                        If mergedText <> "" Then
                            mergedText = mergedText & vbCrLf & ws.Cells(i, j).Value
                        Else
                            mergedText = ws.Cells(i, j).Value
                        End If
                        ws.Cells(mergeRow, j).Value = mergedText
                    End If
                Next j
                ' 标记待删除行
                ws.Cells(i, "A").Value = "DELETE"
                i = i + 1
            Else
                Exit Do
            End If
        Loop
    Next assetID
    
    ' 删除标记的冗余行
    lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
    For i = lastRow To 2 Step -1
        If ws.Cells(i, "A").Value = "DELETE" Then
            ws.Rows(i).Delete
        End If
    Next i
End Sub

思路2：先填充缺失AssetID再合并 #

先向下填充AssetID列的空值，让每一行都有对应的AssetID，再通过字典按AssetID聚合各列数据，最后清空原数据并写入合并结果。

Sub MergeAfterFillAssetID()
    Dim ws As Worksheet
    Dim lastRow As Long, colCount As Long
    Dim assetDict As Object
    Dim i As Long, j As Long
    Dim assetKey As String, cellValue As String
    
    Set ws = ActiveSheet
    lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
    colCount = ws.UsedRange.Columns.Count
    Set assetDict = CreateObject("Scripting.Dictionary")
    
    ' 步骤1：填充AssetID列的空值
    ws.Range("A2:A" & lastRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    ws.Range("A2:A" & lastRow).Value = ws.Range("A2:A" & lastRow).Value ' 公式转成值
    
    ' 步骤2：用字典聚合各列数据
    For i = 2 To lastRow
        assetKey = CStr(ws.Cells(i, "A").Value)
        If Not assetDict.Exists(assetKey) Then
            ' 首次遇到该AssetID，初始化数组存储各列数据
            assetDict(assetKey) = Array(assetKey)
            ReDim Preserve assetDict(assetKey)(1 To colCount)
            For j = 2 To colCount
                assetDict(assetKey)(j) = ws.Cells(i, j).Value
            Next j
        Else
            ' 合并已有数据
            For j = 2 To colCount
                cellValue = ws.Cells(i, j).Value
                If cellValue <> "" Then
                    If assetDict(assetKey)(j) <> "" Then
                        assetDict(assetKey)(j) = assetDict(assetKey)(j) & vbCrLf & cellValue
                    Else
                        assetDict(assetKey)(j) = cellValue
                    End If
                End If
            Next j
        End If
    Next i
    
    ' 步骤3：清空原数据（保留表头），写入合并结果
    ws.Range("A2:" & ws.Cells(lastRow, colCount).Address).ClearContents
    i = 2
    For Each assetKey In assetDict.Keys
        For j = 1 To colCount
            ws.Cells(i, j).Value = assetDict(assetKey)(j)
        Next j
        i = i + 1
    Next assetKey
End Sub

使用说明 #

• 假设AssetID列在A列，第1行为表头，可根据实际情况修改代码中的列号。
• 两种方案都会自动跳过空值，合并时用换行符（vbCrLf）分隔非空文本。
• 处理范围基于UsedRange，自动识别数据末尾。

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