Excel自定义VBA函数CMM下拉返回#VALUE!错误及代码优化求助

问题原因 #

核心错误出在Flatness函数的ActiveCell调用：下拉填充公式时，ActiveCell始终为你首次输入公式的B1单元格，不会跟随填充位置自动切换为当前正在计算的B2~B100单元格，导致Offset(1, -1)取到的单元格完全不符合预期，找不到DV=、TO=标识就会抛出#VALUE!错误。
手动双击单元格回车时，被编辑的单元格会成为新的ActiveCell，位置匹配后计算就会恢复正常。

修复方法 #

将Flatness函数中的ActiveCell替换为Application.Caller，该对象会自动指向调用当前自定义函数的单元格，不需要依赖激活状态。同时补全基础错误判断，避免找不到标识时报错。

优化后完整代码 #

Option Explicit

Function TextColon(Num1 As String) As String
    Dim colonPos As Long
    colonPos = InStr(1, Num1, ":")
    If colonPos > 0 Then
        TextColon = Trim(Mid(Num1, colonPos + 2))
    Else
        TextColon = "未找到冒号"
    End If
End Function

' 移除没用的Num1参数
Function Flatness() As String
    Dim CellAddress As String
    Dim dvPos As Long, toPos As Long
    ' 用Application.Caller获取当前公式所在单元格
    CellAddress = Application.Caller.Offset(1, -1).Value
    dvPos = InStr(1, CellAddress, "DV=")
    toPos = InStr(1, CellAddress, "TO=")
    If dvPos > 0 And toPos > 0 And toPos > dvPos Then
        Flatness = Trim(Mid(CellAddress, dvPos + 3, toPos - dvPos - 3))
    Else
        Flatness = "未匹配到数据"
    End If
End Function

Function Diameter(ByVal Num1 As String) As String
    Dim avPos As Long, nvPos As Long
    avPos = InStr(1, Num1, "AV=")
    nvPos = InStr(1, Num1, "NV=")
    If avPos > 0 And nvPos > 0 And nvPos > avPos Then
        Diameter = Trim(Mid(Num1, avPos + 3, nvPos - avPos - 3))
    Else
        Diameter = "未匹配到数据"
    End If
End Function

' 这个工具方法只适合在SUB过程中调用，不要在自定义函数里用
Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    ActiveSheet.DisplayPageBreaks = Not (isOn)
End Sub

Function CMM(ByVal Num1 As String) As String
    Dim Output As String
    Dim CaseType As String
    
    ' 删掉这里的OptimizeVBA调用，自定义函数不能修改全局配置
    CaseType = Trim(Left(Num1, 18))
        
    Select Case CaseType
    Case "PART NUMBER", "REV", "OPERATION", "INSP / SN#", "DATE / TIME"
        Output = TextColon(Num1)
    Case "Diameter", "Position X", "Position Y", "Position Z", "Distance X", "Distance Y", "Distance Z", "Cone ang."
        Output = Diameter(Num1)
    Case "Flatness", "Perpendicularity", "Concentricity"
        ' Flatness不再需要传参数
        Output = Flatness()
    Case Else
        Output = "No Value"
    End Select
    
    CMM = Output
End Function

其他优化建议 #

• 不要在自定义函数中修改Excel全局配置：OptimizeVBA修改的计算模式、屏幕更新等属性，仅适合在手动执行的Sub过程前后调用，放在自定义函数中不仅不会提升效率，还会导致Excel运行状态异常。
• 按需添加自动重算配置：如果A列数据会动态更新，可以在所有自定义函数的第一行添加Application.Volatile True，保证数据变动时函数自动重算，不需要手动触发。
• 可以根据业务需求调整异常返回值，比如返回CVErr(xlErrNA)让单元格显示标准的#N/A错误，方便其他公式判断。

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