VBA代码遇Run-Time Error 438及编译错误求助

原代码核心问题 #

• VBA原生Collection没有AddIfAbsent或Exists方法，这是运行时错误438的直接原因。
• SortedUniqueIDs未初始化且未赋值，同时For Each循环的控制变量ID声明为String，但集合元素是Variant类型，导致编译错误。
• 汇总逻辑错误：全局Sum变量无法独立跟踪每个ID的累计值，且引用的列（Sheet1的B列）与需求的D列不符。
• 输出逻辑混乱：未按要求将结果输出到F列，且行号处理错误。

修正后的代码 #

使用VBA的Dictionary对象替代Collection，它原生支持键的唯一性检查和键值对操作，完美适配需求：

Sub SumUniqueIdentifiers()
    ' 声明变量
    Dim wsTH As Worksheet
    Dim idDict As Object
    Dim currentID As Variant
    Dim lastRow As Long
    Dim i As Long
    Dim outputRow As Long
    
    ' 初始化工作表对象（避免使用Activate）
    Set wsTH = ThisWorkbook.Sheets("TH")
    ' 初始化Dictionary
    Set idDict = CreateObject("Scripting.Dictionary")
    
    ' 获取数据最后一行
    lastRow = wsTH.Range("A" & wsTH.Rows.Count).End(xlUp).Row
    
    ' 遍历数据，汇总每个ID对应的D列值
    For i = 3 To lastRow
        currentID = wsTH.Cells(i, 1).Value
        ' 如果ID不存在，初始化值为0；否则累加D列值
        If idDict.Exists(currentID) Then
            idDict(currentID) = idDict(currentID) + wsTH.Cells(i, 4).Value
        Else
            idDict(currentID) = wsTH.Cells(i, 4).Value
        End If
    Next i
    
    ' 准备输出到F列，从第3行开始（和数据起始行一致）
    outputRow = 3
    ' 清空F列旧数据
    wsTH.Range("F" & outputRow & ":F" & wsTH.Rows.Count).ClearContents
    
    ' 遍历Dictionary，输出结果到F列对应的行
    For Each currentID In idDict.Keys
        wsTH.Cells(outputRow, 6).Value = currentID
        wsTH.Cells(outputRow, 7).Value = idDict(currentID) ' 可根据需求调整到其他列，这里保留原代码的G列存汇总值
        outputRow = outputRow + 1
    Next currentID
    
    ' 释放对象
    Set idDict = Nothing
    Set wsTH = Nothing
End Sub

关键修改说明 #

• 用Scripting.Dictionary替代Collection：利用Exists方法检查ID是否已存在，直接通过键值对维护每个ID的累计值。
• 避免使用Activate/ActiveSheet：直接绑定工作表对象，提升代码稳定性和可读性。
• 修正列引用：将原代码的Sheet1的B列改为目标工作表的D列（Cells(i,4)）。
• 规范输出逻辑：清空F列旧数据，按顺序输出每个ID及其汇总值，行号从数据起始行（第3行）开始。
• 修复For Each循环问题：使用Variant类型的currentID遍历Dictionary的键，符合VBA语法要求。

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