基于重复Item Code合并Excel记录的VBA代码适配求助

以下是适配你当前数据结构的VBA代码，实现按F列（Item Code）合并记录、保留首个ID（A列）、非数值列保留首次出现值、AJ-CO列数值求和的功能：

Sub MergeDuplicateItems()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim itemCol As Integer, idCol As Integer
    Dim sumStartCol As Integer, sumEndCol As Integer
    Dim dict As Object
    Dim i As Long, j As Integer
    Dim key As String
    Dim outputRow As Long
    
    ' 设置目标工作表（可修改为Sheet1等指定表名）
    Set ws = ActiveSheet
    ' 定义关键列的位置
    itemCol = 6 ' Item Code在F列（第6列）
    idCol = 1 ' ID在A列（第1列）
    sumStartCol = 36 ' 求和起始列AJ（第36列）
    sumEndCol = 93 ' 求和结束列CO（第93列）
    
    ' 获取数据最后一行和最后一列
    lastRow = ws.Cells(ws.Rows.Count, itemCol).End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' 创建字典存储Item Code对应的记录信息
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历数据行（从第2行开始，假设第1行是表头）
    For i = 2 To lastRow
        key = Trim(ws.Cells(i, itemCol).Value)
        If key <> "" Then
            If Not dict.Exists(key) Then
                ' 首次出现的Item Code，完整记录非数值列+初始化数值列
                dict.Add key, Array( _
                    ws.Cells(i, idCol).Value, ' 保存ID
                    ws.Range(ws.Cells(i, 1), ws.Cells(i, itemCol - 1)).Value, ' 保存A-E列数据
                    ws.Range(ws.Cells(i, itemCol + 1), ws.Cells(i, sumStartCol - 1)).Value, ' 保存G-AI列数据
                    ws.Range(ws.Cells(i, sumStartCol), ws.Cells(i, sumEndCol)).Value ' 初始化求和列数据
                )
            Else
                ' 重复的Item Code，累加数值列数据
                Dim existingSum As Variant
                existingSum = dict(key)(3)
                For j = sumStartCol To sumEndCol
                    existingSum(1, j - sumStartCol + 1) = existingSum(1, j - sumStartCol + 1) + ws.Cells(i, j).Value
                Next j
                dict(key)(3) = existingSum
            End If
        End If
    Next i
    
    ' 清空原数据（保留表头）
    ws.Rows("2:" & lastRow).ClearContents
    
    ' 将合并后的数据写入工作表
    outputRow = 2
    For Each key In dict.Keys
        ' 写入ID
        ws.Cells(outputRow, idCol).Value = dict(key)(0)
        ' 写入A-E列数据
        ws.Range(ws.Cells(outputRow, 1), ws.Cells(outputRow, itemCol - 1)).Value = dict(key)(1)
        ' 写入Item Code
        ws.Cells(outputRow, itemCol).Value = key
        ' 写入G-AI列数据
        ws.Range(ws.Cells(outputRow, itemCol + 1), ws.Cells(outputRow, sumStartCol - 1)).Value = dict(key)(2)
        ' 写入求和后的数值列数据
        ws.Range(ws.Cells(outputRow, sumStartCol), ws.Cells(outputRow, sumEndCol)).Value = dict(key)(3)
        
        outputRow = outputRow + 1
    Next key
    
    ' 释放对象
    Set dict = Nothing
    Set ws = Nothing
    
    MsgBox "合并完成！"
End Sub

关键部分说明 #

• 列位置定义：代码开头的四个变量itemCol、idCol、sumStartCol、sumEndCol用于指定关键列的位置，可根据实际数据结构随时修改数值。
• 字典存储逻辑：首次出现的Item Code会完整保存其非数值列数据，并初始化数值列；重复的Item Code仅累加数值列的值，非数值列始终保留首次出现的内容。
• 数据写入：遍历字典时，按顺序将保存的ID、非数值列、Item Code、求和后的数值列写入工作表。

使用注意事项 #

1. 确保工作表表头在第1行，数据从第2行开始。
2. 若ID列不是A列，修改idCol的数值即可。
3. 运行代码前建议备份原始数据，避免意外数据丢失。

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