VBA代码触发Run-time error '13'类型不匹配错误求助

错误原因分析 #

你的错误行Cells(i, "E").Value = .WorksheetFunction.Ceiling(Cells(i, "D").Value * Cells(1, "B").Value, 1)触发类型不匹配，核心原因有两点：

1. 循环过程中会清空Total行的D列值，当循环到这些行时，Cells(i,"D").Value为空，与B1数值相乘时产生非数值结果，导致Ceiling函数参数类型错误
2. 循环范围包含lRow+1，可能超出有效数据行，遇到非数值单元格

修正后的完整代码 #

以下代码修复了类型错误，同时满足所有功能需求（动态适配增删行、区域汇总、Total3累计逻辑等）：

Private Sub Worksheet_Change(ByVal Target As Range)
    calculatePercentage
End Sub

Sub calculatePercentage()
    Dim i As Long, lRow As Long
    Dim subTotal As Long, total2Percent As Double, total2Value As Long
    Dim percentageSum As Double, allFilled As Boolean
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    lRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    allFilled = True
    
    ' 检查所有非Total行的D列是否已填写
    For i = 2 To lRow
        If InStr(ws.Cells(i, "C").Value, "Total") = 0 And IsEmpty(ws.Cells(i, "D").Value) Then
            allFilled = False
            Exit For
        End If
    Next
    
    If allFilled Then
        With Application
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With
        
        ' 清空旧计算结果
        ws.Range("E2:E" & lRow).Clear
        ws.Range("D:D").SpecialCells(xlCellTypeConstants, xlNumbers).NumberFormat = "0.00%"
        
        subTotal = 0
        percentageSum = 0
        total2Percent = 0
        total2Value = 0
        
        For i = 2 To lRow
            ' 计算非Total行的Value列
            If InStr(ws.Cells(i, "C").Value, "Total") = 0 Then
                ' 确保单元格是数值类型再计算
                If IsNumeric(ws.Cells(i, "D").Value) And IsNumeric(ws.Cells(1, "B").Value) Then
                    ws.Cells(i, "E").Value = Application.WorksheetFunction.Ceiling_Precise(ws.Cells(i, "D").Value * ws.Cells(1, "B").Value, 1)
                    percentageSum = percentageSum + ws.Cells(i, "D").Value
                    subTotal = subTotal + ws.Cells(i, "E").Value
                End If
            Else
                ' 处理Total行
                Select Case ws.Cells(i, "C").Value
                    Case "Total 1"
                        ws.Cells(i, "D").Value = percentageSum
                        ws.Cells(i, "D").NumberFormat = "0.00%"
                        ws.Cells(i, "E").Value = subTotal
                        ' 重置小计，准备Total2计算
                        percentageSum = 0
                        subTotal = 0
                    Case "Total 2"
                        ws.Cells(i, "D").Value = percentageSum
                        ws.Cells(i, "D").NumberFormat = "0.00%"
                        ws.Cells(i, "E").Value = subTotal
                        ' 保存Total2的总计值，用于Total3计算
                        total2Percent = ws.Cells(i, "D").Value
                        total2Value = ws.Cells(i, "E").Value
                        ' 重置小计，准备Total3计算
                        percentageSum = 0
                        subTotal = 0
                    Case "Total 3"
                        ' Total3总计 = Total2总计 + 当前区域小计
                        ws.Cells(i, "D").Value = total2Percent + percentageSum
                        ws.Cells(i, "D").NumberFormat = "0.00%"
                        ws.Cells(i, "E").Value = total2Value + subTotal
                End Select
            End If
        Next
        
        With Application
            .EnableEvents = True
            .Calculation = xlCalculationAutomatic
        End With
    End If
End Sub

关键优化点 #

• 增加IsNumeric判断，确保只有数值单元格才参与计算，避免类型不匹配
• 按Total 1/2/3分别处理逻辑，实现Total3的累计需求
• 以C列（包含Total标识）作为有效行判断依据，适配动态增删行
• 禁用事件和手动计算，提升运行效率并避免循环触发Worksheet_Change
• 统一设置百分比格式，确保显示规范

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