按Req ID分组合并数据的Excel VBA代码需求

需求说明 #

现有Excel表格包含Req ID.、Impacted App、Manager三列，同一Req ID.对应多条重复记录，需要实现：

• 将同一Req ID.对应的Impacted App合并为逗号分隔的字符串
• 将同一Req ID.对应的Manager去重后合并为逗号分隔的字符串
• 最终在新工作表生成每个Req ID.仅占一行的结果表格

原表格示例 #

期望结果表格 #

VBA代码实现 #

Sub MergeAndDeduplicateData()
    Dim wsSource As Worksheet, wsResult As Worksheet
    Dim lastRow As Long, i As Long, resultRow As Long
    Dim reqID As String, appStr As String
    Dim managerDict As Object
    
    ' 指定源工作表（按需修改工作表名称）
    Set wsSource = ThisWorkbook.Worksheets("数据源")
    ' 创建新工作表存放结果
    Set wsResult = ThisWorkbook.Worksheets.Add
    wsResult.Name = "合并结果"
    
    ' 写入结果表头
    wsResult.Range("A1:C1") = Array("Req ID.", "Impacted App", "Manager")
    resultRow = 2
    
    ' 获取源数据最后一行行号
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 先对源数据按Req ID排序（避免分组逻辑出错，若已排序可注释）
    wsSource.Range("A1:C" & lastRow).Sort Key1:=wsSource.Range("A1"), Order1:=xlAscending, Header:=xlYes
    
    ' 遍历源数据分组处理
    For i = 2 To lastRow
        reqID = wsSource.Cells(i, "A").Value
        appStr = wsSource.Cells(i, "B").Value
        ' 用字典实现Manager去重
        Set managerDict = CreateObject("Scripting.Dictionary")
        managerDict(wsSource.Cells(i, "C").Value) = ""
        
        ' 合并当前Req ID下的所有记录
        Do While i < lastRow And wsSource.Cells(i + 1, "A").Value = reqID
            i = i + 1
            appStr = appStr & ", " & wsSource.Cells(i, "B").Value
            ' 仅添加未存在的Manager
            If Not managerDict.Exists(wsSource.Cells(i, "C").Value) Then
                managerDict(wsSource.Cells(i, "C").Value) = ""
            End If
        Loop
        
        ' 将处理后的数据写入结果表
        wsResult.Cells(resultRow, "A").Value = reqID
        wsResult.Cells(resultRow, "B").Value = appStr
        wsResult.Cells(resultRow, "C").Value = Join(managerDict.Keys, ", ")
        resultRow = resultRow + 1
    Next i
    
    ' 自动调整结果表列宽
    wsResult.Columns("A:C").AutoFit
    
    MsgBox "数据合并完成，结果已保存到""合并结果""工作表", vbInformation
End Sub

代码关键点说明 #

• 工作表配置：代码默认源数据在数据源工作表，结果存入新建的合并结果工作表，可根据实际修改名称
• 字典去重：借助Scripting.Dictionary的键唯一性实现Manager列的去重，避免重复值
• 分组逻辑：通过Do While循环批量处理同一Req ID的所有行，提升处理效率
• 排序前置：代码内置了排序逻辑，确保同一Req ID的记录连续，若源数据已提前排序可注释该行

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