表格中的计算式如何能添加备注信息后可以正常计算结果

sun4400

大灰狼1976

要保持参与计算有两个方法：
1、使用自定义格式显示备注内容；
2、使用自定义函数计算。

半百

比如

34682189

'返回表达式的值
Public Function JS(jss, Optional xs As Variant)
Dim jsz
If Len(jss) = 0 Then JS = "": Exit Function
jss = Replace(jss, "{", "(")
jss = Replace(jss, "}", ")")
Do
If UBound(Split(jss, "[")) <> UBound(Split(jss, "]")) Then JS = "括号错误": Exit Function
If InStr(jss, "[") > InStr(jss, "]") Then JS = "括号错误": Exit Function
If InStr(jss, "[") = 0 Then Exit Do
jss = Left(jss, InStr(jss, "[") - 1) & Right(jss, Len(jss) - InStr(jss, "]"))
If InStr(jss, "]") = 0 Then Exit Do
Loop
If Left(jss, 1) = "=" Then
Do Until Left(jss, 1) <> "="
jss = Mid(jss, 2)
Loop
End If
On Error GoTo ERR001
If Len(jss) = 0 Then JS = "": Exit Function
If Len(jss) > 254 Then JS = "公式超长": Exit Function
If IsMissing(xs) Or IsNumeric(xs) = True Then
jsz = Evaluate("=" & jss)
If IsNumeric(xs) = True Then
jsz = IIf(Int(Abs(xs)) < 9, Round(jsz, Int(Abs(xs))), Round(jsz, 9))
End If
JS = IIf(IsNumeric(jsz) = True, jsz, "公式错误")
ElseIf UCase(xs) = "GS" Then
JS = jss
Else
GoTo ERR001
End If
Exit Function
ERR001:
JS = "公式错误"
End Function

sun4400

34682189 发表于 2024-2-3 15:49
'返回表达式的值
Public Function JS(jss, Optional xs As Variant)
Dim jsz

好用，非常感谢