请求修改VBA代码：当E列值重复且G列值为Kede时，对I列值求和并删除重复行

你的需求回顾 #

你需要实现的功能是：当E列的值重复，且对应行的G列值为"Kede"时，对这些行的I列数值求和，保留第一行并删除其他重复行，同时把求和结果更新到保留行的I列中。

原代码逻辑分析 #

先给你拆解一下原代码的核心逻辑，这样你能明白它原本是怎么工作的：

• 定义变量：工作表对象、最后一行行号、字典（用来存E列唯一值和对应的I列求和结果+首次出现的单元格地址）、要删除的行范围、数组等。
• 读取E列数据到数组arrE，用字典去重：
  • 遍历E列每一行，如果字典里没有当前E列值，就把这个值作为键，存入「I列单元格地址|I列数值」的字符串。
  • 如果字典里已有这个E列值，就拆分之前存的字符串，把当前I列数值累加上去，同时把当前行标记为要删除的行。
• 最后把字典里的求和结果写回I列对应的位置，删除所有标记的重复行。

你修改后的代码存在的问题 #

你修改的版本有几个关键错误：

1. 字典键选错了：你把原代码的E列换成了G列，这意味着现在是按G列值去重，而不是需求里的E列，完全偏离了目标。
2. 单元格引用错误：ThisWorkbook.Worksheets("BOM").Range(i, G).Value是错误写法，G是列名，应该用Cells(i+1, "G")（因为数组arrG从第2行开始，i是数组索引，对应工作表行是i+1）。
3. 条件判断位置错误：你把G列的判断放在了字典不存在的分支里，这会导致只有首次出现的G列值为"Kede"的行才会被存入字典，后续重复的E列行即使G列是Kede也不会被处理。
4. LastRow的取值逻辑错误：原代码用E列取最后一行，你换成了G列，可能导致漏处理数据（如果E列的最后一行比G列靠下）。

修正后的代码 #

下面是符合你需求的完整代码：

'Declare variables
Dim AcSh As Worksheet, LastRow As Long, dict As Object
Dim rngDel As Range, arrE, arrG, arrInt, arrI, i As Long, dKey
Set AcSh = ActiveSheet
'取E列的最后一行，确保覆盖所有数据
LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
'读取E列和G列的数据到数组，提高效率
arrE = AcSh.Range("E2:E" & LastRow).Value
arrG = AcSh.Range("G2:G" & LastRow).Value
Set dict = CreateObject("Scripting.Dictionary")
'Sum and delete duplicates with condition
On Error Resume Next
For i = 1 To UBound(arrE)
    '先判断当前行G列是否为"Kede"，用UCase避免大小写问题
    If UCase(arrG(i, 1)) = "KEDE" Then
        '再判断E列值是否已在字典中
        If Not dict.Exists(arrE(i, 1)) Then
            '首次出现：存入E列值为键，记录I列地址和初始值
            dict.Add arrE(i, 1), AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
        Else
            '重复出现：拆分已有数据，累加I列值
            arrInt = Split(dict(arrE(i, 1)), "|")
            dict(arrE(i, 1)) = arrInt(0) & "|" & CDbl(arrInt(1)) + CDbl(AcSh.Range("I" & i + 1).Value)
            '标记当前行为要删除的行
            If rngDel Is Nothing Then
                Set rngDel = AcSh.Range("E" & i + 1)
            Else
                Set rngDel = Union(rngDel, AcSh.Range("E" & i + 1))
            End If
        End If
    End If
Next i
On Error GoTo 0 '关闭错误捕获，避免隐藏其他问题
'准备数组存储更新后的I列值
ReDim arrI(1 To LastRow, 1 To 1)
'遍历字典，把求和结果写入对应行的数组位置
For Each dKey In dict.keys()
    arrInt = Split(dict.Item(dKey), "|")
    arrI(Range(arrInt(0)).Row - 1, 1) = CDbl(arrInt(1))
Next
'更新I列并删除重复行
If Not rngDel Is Nothing Then
    '把数组值写入I列，比逐个单元格写入快
    AcSh.Range("I2").Resize(LastRow - 1, 1).Value = arrI
    '删除标记的重复行
    rngDel.EntireRow.Delete
End If

修正后代码的详细逻辑解释 #

我逐段给你讲清楚每一步的作用：

1. 变量定义与初始化

   • 定义了工作表对象AcSh（指向当前活动表）、最后一行行号LastRow、字典dict（用来存唯一值和求和信息）等变量。
   • 用E列取最后一行，确保不会漏处理任何有E列数据的行。
   • 把E列和G列的数据读取到数组arrE和arrG，数组操作比直接读取单元格快很多，适合处理大量数据。

2. 遍历处理每一行

   • 先判断当前行的G列值是否为"Kede"（用UCase统一转大写，避免大小写不一致导致的判断错误，比如"kede"或"KEDE"也能匹配）。
   • 如果G列符合条件，再检查E列值是否在字典中：
     • 首次出现：把E列值作为字典的键，值存为「I列单元格地址|I列数值」的字符串，这样既记录了求和的初始值，又知道要把结果写回哪一行。
     • 重复出现：拆分字典里的字符串，把当前行的I列数值累加到已有结果里，同时把当前行加入到要删除的行范围rngDel中。

3. 更新I列数据并删除重复行

   • 定义数组arrI，用来存储更新后的I列值，这样可以一次性写入工作表，提高效率。
   • 遍历字典的所有键，把每个键对应的求和结果写入arrI中对应的行位置（通过之前存的单元格地址找到行号）。
   • 把arrI的值写入I列，然后删除所有标记的重复行。

额外提示 #

• 我添加了On Error GoTo 0关闭错误捕获，原代码的On Error Resume Next会隐藏所有错误，不利于调试。
• 如果你的数据量很大，数组操作比直接操作单元格要高效得多，这也是原代码用数组的原因。

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