VBA代码构造Key时触发类型不匹配运行时错误的排查与解决

错误根源拆解 #

1. Key构造范围错误：原代码用cell.Resize(1,7)只取当前行前7列，但实际需要的是第9、10、11、18、19、20、21列，范围不对导致取数错误，触发类型不匹配。
2. 变量未声明：循环检查数值的变量i没声明，隐式类型可能引发异常。
3. 字典操作顺序颠倒：先执行dict(key) = values添加空数组，导致后续dict.Exists(key)永远为真，无法正确初始化新分组的求和数据。
4. Sheet2匹配逻辑失效：循环Sheet2时没构造当前行的分组Key，直接用最后一次循环的旧Key，完全无法匹配正确分组。
5. 空值/错误值未处理：单元格为空或包含错误值时，Join函数无法处理非字符串类型数据，触发类型不匹配。

修正后的完整代码 #

Sub UpdatePremiumValues()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim dataRange1 As Range
    Dim dataRange2 As Range
    Dim row As Range
    Dim dict As Object
    Dim key As String
    Dim values(1 To 6) As Double
    Dim colIndices As Variant
    Dim i As Integer
    Dim cellVal As Variant
    
    ' 定义分组列的索引（第9、10、11、18、19、20、21列）
    colIndices = Array(9, 10, 11, 18, 19, 20, 21)
    
    ' 绑定工作表
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' 获取最后一行数据
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    
    ' 设置数据范围（从第2行到最后一行）
    Set dataRange1 = ws1.Range("A2:AI" & lastRow1)
    Set dataRange2 = ws2.Range("A2:AI" & lastRow2)
    
    ' 创建字典对象
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历Sheet1数据，构建分组求和字典
    For Each row In dataRange1.Rows
        key = ""
        ' 构造分组Key
        For Each col In colIndices
            cellVal = row.Cells(1, col).Value
            ' 处理空值和错误值，避免类型不匹配
            If IsError(cellVal) Then
                cellVal = "ERROR"
            ElseIf cellVal = "" Then
                cellVal = "EMPTY"
            End If
            key = key & CStr(cellVal) & "|"
        Next col
        ' 移除末尾多余的分隔符
        key = Left(key, Len(key) - 1)
        
        ' 检查Key是否已存在
        If dict.Exists(key) Then
            ' 累加求和
            dict(key)(1) = dict(key)(1) + row.Cells(1, 28).Value ' Net Premium (SGD)
            dict(key)(2) = dict(key)(2) + row.Cells(1, 29).Value ' 1st Premium (SGD)
            dict(key)(3) = dict(key)(3) + row.Cells(1, 30).Value ' 2nd Premium (SGD)
            dict(key)(4) = dict(key)(4) + row.Cells(1, 34).Value ' FO Premium (SGD)
            dict(key)(5) = dict(key)(5) + row.Cells(1, 35).Value ' Fac HO Premium (SGD)
            dict(key)(6) = dict(key)(6) + row.Cells(1, 36).Value ' Fac Others Premium (SGD)
        Else
            ' 初始化新分组的求和数据
            values(1) = row.Cells(1, 28).Value
            values(2) = row.Cells(1, 29).Value
            values(3) = row.Cells(1, 30).Value
            values(4) = row.Cells(1, 34).Value
            values(5) = row.Cells(1, 35).Value
            values(6) = row.Cells(1, 36).Value
            dict(key) = values
        End If
    Next row
    
    ' 更新Sheet2的分组求和数据
    For Each row In dataRange2.Rows
        key = ""
        ' 构造当前行的分组Key
        For Each col In colIndices
            cellVal = row.Cells(1, col).Value
            If IsError(cellVal) Then
                cellVal = "ERROR"
            ElseIf cellVal = "" Then
                cellVal = "EMPTY"
            End If
            key = key & CStr(cellVal) & "|"
        Next col
        key = Left(key, Len(key) - 1)
        
        ' 匹配字典中的分组数据并更新
        If dict.Exists(key) Then
            row.Cells(1, 21).Value = dict(key)(1) ' Net Premium (SGD)
            row.Cells(1, 22).Value = dict(key)(2) ' 1st Premium (SGD)
            row.Cells(1, 23).Value = dict(key)(3) ' 2nd Premium (SGD)
            row.Cells(1, 27).Value = dict(key)(4) ' FO Premium (SGD)
            row.Cells(1, 28).Value = dict(key)(5) ' Fac HO Premium (SGD)
            row.Cells(1, 29).Value = dict(key)(6) ' Fac Others Premium (SGD)
        End If
    Next row
    
    ' 清理对象
    Set dict = Nothing
    MsgBox "分组求和及更新完成！"
End Sub

关键修正点说明 #

• 正确构造分组Key：通过循环指定的列索引逐个获取单元格值，统一转为字符串并处理空值、错误值，避免Join函数的类型问题。
• 调整字典操作顺序：先判断Key是否存在，再决定是累加还是初始化数据，避免空数组覆盖问题。
• 修复Sheet2匹配逻辑：为Sheet2的每一行重新构造分组Key，确保匹配正确的求和数据。
• 声明所有变量：避免隐式类型转换错误。

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