如何提取重复ID分组区域的唯一值并合并至相邻列？

针对你的需求——按A列排序后的连续ID分组，提取每组C列唯一值合并到对应B列单元格，最终删除C列，以下是修正后的代码：

Sub Extract_unique_values_and_combine_in_adjacent_cells()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim lastRow As Long: lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    Dim currentID As Variant
    Dim groupStart As Long, groupEnd As Long
    Dim uniqueVals As String
    Dim i As Long
    
    ' 从第2行开始遍历分组（假设第1行是表头）
    groupStart = 2
    currentID = ws.Cells(groupStart, "A").Value
    
    Do While groupStart <= lastRow
        ' 找到当前ID分组的最后一行
        groupEnd = groupStart
        Do While groupEnd + 1 <= lastRow And ws.Cells(groupEnd + 1, "A").Value = currentID
            groupEnd = groupEnd + 1
        Loop
        
        ' 获取当前分组C列的唯一值，用换行分隔
        uniqueVals = unique(ws.Range("C" & groupStart & ":C" & groupEnd).Value2)
        
        ' 将唯一值合并到当前分组的所有B列单元格
        For i = groupStart To groupEnd
            ' 避免重复添加，只在原内容后追加一次唯一值
            If InStr(ws.Cells(i, "B").Value, uniqueVals) = 0 Then
                ws.Cells(i, "B").Value = ws.Cells(i, "B").Value & vbLf & uniqueVals
                ' 去除开头的换行（如果原B列是空的）
                If Left(ws.Cells(i, "B").Value, 1) = vbLf Then
                    ws.Cells(i, "B").Value = Mid(ws.Cells(i, "B").Value, 2)
                End If
            End If
        Next i
        
        ' 移动到下一个分组
        groupStart = groupEnd + 1
        If groupStart <= lastRow Then
            currentID = ws.Cells(groupStart, "A").Value
        End If
    Loop
    
    ' 删除C列
    ws.Columns("C").Delete
End Sub

Function unique(crg)
    Dim cel As Variant
    Dim dict As Object: Set dict = CreateObject("scripting.dictionary")
    
    ' 遍历区域，存入字典去重
    For Each cel In crg
        If Not IsEmpty(cel) Then ' 跳过空值
            dict(cel) = vbNullString
        End If
    Next cel
    
    ' 将字典键用换行连接返回
    unique = Join(dict.Keys, vbLf)
End Function

关键改动说明 #

• 动态识别分组：通过嵌套循环定位每个连续ID分组的起始、结束行，替代原代码的硬编码固定区域
• 空值过滤：在unique函数中跳过空单元格，避免无效空字符串混入结果
• 重复追加防护：检查B列单元格内容，防止同一分组的唯一值被重复添加
• 格式优化：自动去除B列单元格开头可能出现的多余换行符
• 收尾处理：完成合并后直接删除C列，一步到位满足需求

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