关于EXCEL超长计算式的解决方案

岁月无恒 · 发表于 2021-9-21 17:04

今天分享的是，关于excel中超长计算式的解决方案。

自定义函数.rar (19.07 KB, 下载次数: 54)

刚才分享了一篇关于在excel中，用EVALUATE函数自动计算表达式结果，且支持注释（可在本人主页中查看）。

但是那个方法有两个缺陷：

1、注释的位置必须统一，要么在数值前面，要么在数值后面，否则结果就会出错。

2、计算式太长，结果就会出错。

但是作为建筑行业从业人员，在需要手动算量时，难免遇到一些复杂情况，写出一个超级长的计算式。为解决以上两个痛点，写了一个自定义函数，大家演示效果。

一、加载宏

下载开头的加载宏文件，并加载到excel中，就可以使用。下面是加载宏的演示。

二、使用函数

当把自定义函数加载宏文件加载到excel中时，这个函数就可以像excel的内置函数一样使用了。这个函数的特点：

1、可以计算超长字符的计算式；
2、对注释内容的位置没有要求，可以随意在计算式中做注释；
3、计算式中支持使用excel的内置函数；
4、可以直接引用单元格，比定义名称更方便。

三、移植代码

如果在文件中使用了加载宏的函数，这个文件发送给其他人后，若没有加载自定义函数的代码，结果就会显示错误。怎么样让这个函数和文件放到一起呢？就需要将自定义函数的代码放到需要这个函数的文件中，下面是操作演示:：

1、先在VBE编辑器中，打开加载宏文件的自定义函数代码，全部复制下来；

2、在需要这个函数的文件中，在VBE界面插入【模块】，然后将代码粘贴到模块中；

3、取消加载宏后，就可以正常使用此函数了，并且函数也和文件一起了。

三、这个自定义函数的思路

如果只需要这个函数，看到这里就可以了。下面介绍的是这个自定义函数的思路。

由于【EVALUATE】函数不支持超过255字符的计算式，那么，就通过计算式拆分的方式，将一个超长的计算式不断拆分、简化和计算，使其长度最终小于255个字符的目的，最后再使用【EVALUATE】函数计算出结果。

清除注释信息→将函数公式部分转换为结果→将括号部分转化为结果→得到一个无括号的四则运算计算式→（若计算式长度＞255字符）→再从左开始以×/÷号为分隔符号，截取小于255字符的一段计算式，将其转化为结果，替换到计算式中；如此反复操作，直到计算式的长度≤255个字符。

1、清除计算式中的注释信息。

文字注释要占用计算式的长度，且会影响计算，所以首先就是将注释内容清除，这是简化计算式的第一步；

2、将计算式中的函数公式部分转化为结果

函数有括号，且有些函数的参数不能提前转换为结果，所以在简化括号内容之前，需要先将函数公式部分转换为结果，并用结果替换掉原来的函数公式部分。

3、简化括号

在四则运算中，括号的运算级别较高，为避免结果出错，所以需要先对括号内的内容进行计算。

简化括号，难点在于判断括号的层数、判断哪个左括号和哪个右括号是一对的，尤其是遇到复杂的括号时，如果判断不对，就会导致计算结果出错。只有判断正确了，才能将一对括号中的内容提取出来，并正确地转化为结果，然后导入到计算式中。

然后一步一步地重复这个操作，直到所有括号都简化完毕，就得到一个无括号的四则运算的计算式。

4、简化计算式

如果经过上述操作，简化后最终的计算式还大于256字符，那么就用加减符号将计算式拆分为无数段，按照从左往右的顺序，先将乘除的部分计算成结果，然后替换到计算式中。然后不断重复上述操作，直到计算式长度达到要求。

经过以上4个步骤，再长的计算式，几乎都可以简化，那么，只要excel单元格中能录入的计算式，用这个自定义函数都可以计算了。

四、函数代码如下：

加上函数代码，文章内容就超长了，代码在楼下分享。

岁月无恒 · 发表于 2021-9-21 17:06

四、函数代码如下：

Function MyValue(Rng As Range, Optional Point As Integer = 2)
'===================================清除计算式的注释===================================
Dim Tmp As String, 计算式 As String
'====================================修正运算符号====================================
Tmp = Rng.Value '将单元格内容赋值给变量
Tmp = Replace(Tmp, " ", "") '清除计算式中的空格
Tmp = Replace(Replace(Tmp, "（", "("), "）", ")") '中文括号转换为英文括号
Tmp = Replace(Replace(Tmp, "[", "("), "]", ")") '中括号转换为小括号
Tmp = Replace(Replace(Tmp, "{", "("), "}", ")") '大括号转换为小括号
Tmp = Replace(Replace(Tmp, "×", "*"), "÷", "/") '乘号、除号转换为计算符号
'===================================清除计算式的注释===================================
'注释内容一定要用【】标记，否侧会影响后面的判断
If VBA.InStr(Tmp, "【") > 0 Then
Dim i As Integer, j As Integer
For i = 1 To VBA.Len(Tmp)
If VBA.Mid(Tmp, i, 1) = "【" Then
Do
j = j + 1
Loop Until VBA.Mid(Tmp, i + j, 1) = "】" Or i + j >= VBA.Len(Tmp)
i = i + j
If i > VBA.Len(Tmp) Then
Exit For
Else
j = 0
End If
ElseIf VBA.Mid(Tmp, i, 1) = "】" Then
Else
计算式 = 计算式 & Mid(Tmp, i, 1)
End If
Next
Else
计算式 = Tmp
End If
'清除注释完成，对计算式做初步判断
If Len(计算式) = 0 Then '简化后计算式为空，则无计算式，结果为空
MyValue = ""
Exit Function
ElseIf VBA.InStr("+-*/", Right(计算式, 1)) > 0 Then '如果计算式最后一位是运算符号，则计算式错误，结果为错
MyValue = "错"
Exit Function
End If
'左括号和右括号数量不相等时，计算式有误，结果为错。这里只能先判断括号是否成对
If VBA.Len(Replace(Tmp, "(", "")) <> VBA.Len(Replace(Tmp, ")", "")) Then
MyValue = "错"
Exit Function
End If
'计算式中出现连续的运算符，计算式有误，结果为错
Dim Err, e As Byte
Err = Array("++", "+-", "+*", "+/", "-+", "-*", "-/", "--", "*+", "*-", "**", "*/", "/+", "/-", "/*", "//", ")(")
For e = 0 To UBound(Err)
If VBA.InStr(计算式, Err(e)) > 0 Then
MyValue = "错"
Exit Function
End If
Next
If VBA.Len(计算式) <= 255 Then GoTo 计算 '如果计算式字符数≤255，则直接结算；否则，运行下面的代码
'====================================超长计算式的简化、计算思路====================================
'/计算式长度>255字符，先将计算式中的函数公式通过计算，转化为数值，得到一个纯数字的计算式
'// 如果计算式中存在函数，函数的括号会影响括号的计算，所以需要先把函数部分先转换成结果
'/然后将所得计算式按照四则运算法则：括号→乘除→加减顺序，依次计算、简化，得到一个纯加减的计算式
'// 如果计算式长度>255字符，则以【+、-】为依据，从左开始截取一段小于255字符的计算式，将其转化为数值
'// 然后不断重复上一步操作，直到最终的计算式长度≤255字符，然后直接计算出结果
'========================================计算式中的函数运算========================================
'判断计算式中是否存在函数，若存在，先依次计算函数（以免函数中的括号影响下一步括号计算）
Dim TmpStr1$, TmpValue1 As Double
Dim a1%, b1%, c1%, m1%, n1%, 长度差1% '循环变量和计数器
Do
a1 = a1 + 1 '逐个字符串判断
SS1 = VBA.Mid(计算式, a1, 1)
If VBA.InStr("0123456789~!@#$%^&( )+-*/^<=>.,""", VBA.Mid(计算式, a1, 1)) = 0 Then '当前字符串非数值、运算符、括号、特殊符号
Do
b1 = b1 + 1 '遇到非数值、运算符、括号、特殊符号后，开始计数
Loop Until VBA.InStr("+-*/^()", VBA.Mid(计算式, a1 + b1, 1)) > 0 '逐一判断，直到出现下一个运算符
If VBA.InStr("(（", VBA.Mid(计算式, a1 + b1, 1)) > 0 Then '如果下一个运算符是括号，则表示此处是函数【函数名称(函数参数)】
Do '根据括号判断函数的嵌套层数
c1 = c1 + 1
SS2 = Mid(计算式, a1 + b1 + c1 - 1, 1)
If VBA.InStr("(（", Mid(计算式, a1 + b1 + c1 - 1, 1)) > 0 Then
m1 = m1 + 1 '统计左括号数量
ElseIf VBA.InStr(")）", Mid(计算式, a1 + b1 + c1 - 1, 1)) > 0 Then
n1 = n1 + 1 '统计右括号数量
End If
Loop Until m1 > 0 And n1 > 0 And m1 = n1 Or a1 + b1 + c1 - 1 >= Len(计算式) '当左括号=右括号，或者字符数超过总字符数时，退出Do循环
If m1 = n1 Then '当左右括号相等时，把函数公式部分提取出来，计算结果
TmpStr1 = Mid(计算式, a1, b1 + c1)
TmpValue1 = Excel.Application.Evaluate(TmpStr1)
计算式 = Application.Substitute(计算式, TmpStr1, TmpValue1, 1) '把函数结果写入计算式
长度差1 = VBA.Len(TmpValue1) - VBA.Len(TmpStr1) - 1 '计算计算式与计算结果的字符数量差
a1 = a1 + b1 + c1 + 长度差1 '根据a的位置，结合计算式长度和长度差，将得到的新起始位置赋值给a
b1 = 0: c1 = 0: m1 = 0: n1 = 0 '计数器归零，以便下次使用
End If
End If
End If
Loop Until a1 >= VBA.Len(计算式) '当a的值等于或超过计算式长度时，退出循环
If VBA.Len(计算式) <= 255 Then GoTo 计算 '如果整理后的计算式长度小于等于255，则直接计算
'======================================简化计算式中的括号运算======================================
'如果有括号，先计算括号内的内容
If VBA.InStr(计算式, "(") > 0 Then
Dim TmpValue2 As Double, TmpStr2$
Dim KaiShi%, JieShu%, Dic
Dim a2%, b2%, m2%, n2%, 长度差2%
Set Dic = CreateObject("Scripting.dictionary")
Do
a2 = a2 + 1
If VBA.InStr("(（", Mid(计算式, a2, 1)) > 0 Then '当前字符是左括号
m2 = m2 + 1 '统计左括号数量，即括号层数
Dic(m2) = a2 '用字典记录每个左括号的位置
ElseIf VBA.InStr(")）", Mid(计算式, a2 + 1, 1)) > 0 Then '下一个字符是右括号
Do
b2 = b2 + 1
If VBA.InStr(")）", Mid(计算式, a2 + b2 + 长度差2 - 1, 1)) > 0 Then
n2 = n2 + 1 '依次判断右口号位置，逐层计算
KaiShi = Dic(m2 - n2 + 1)
JieShu = a2 + b2 + 长度差2 - 1
TmpStr2 = Mid(计算式, KaiShi, JieShu - KaiShi + 1)
TmpValue2 = Application.Evaluate(TmpStr2)
计算式 = Application.Substitute(计算式, TmpStr2, TmpValue2) '把括号结果写入计算式
长度差2 = 长度差2 + VBA.Len(TmpValue2) - VBA.Len(TmpStr2) - 1 '计算计算式与计算结果的字符数量差
End If
Loop Until a2 + b2 > VBA.Len(计算式) Or VBA.InStr("(（", Mid(计算式, a2 + b2 + 长度差2, 1)) > 0 '下一位是左括号时
a2 = a2 + b2 + 长度差2 - 1 '根据a的位置，结合计算式长度和长度差，将得到的新起始位置赋值给a
m2 = m2 - n2 '更新括号层数，左括号总数-已算的右括号数量
b2 = 0: n2 = 0: 长度差2 = 0 '计数器归零，以便下次使用
End If
Loop Until a2 >= Len(计算式) '当字符数超过总字符数时，退出Do循环
End If
If VBA.Len(计算式) <= 255 Then GoTo 计算 '如果整理后的计算式长度小于等于255，则直接计算
'======================================简化计算式中的乘除运算======================================
'如果有乘除，再从左往右依次算乘除
If VBA.InStr(计算式, "*") + VBA.InStr(计算式, "/") > 0 Then
Dim TmpValue3 As Double, TmpStr3$, Str3$
Dim a3%, b3%, m3%
Dim Arr(1 To 1000)
Arr(1) = 1
For a3 = 1 To Len(计算式)
If InStr("+-", Mid(计算式, a3, 1)) > 0 Then
m3 = m3 + 1
Arr(m3 + 1) = a3
End If
Next
Arr(m3 + 2) = Len(计算式)
For b3 = 1 To m3 + 1
If b3 = 1 Then
TmpStr3 = Mid(计算式, Arr(b3), Arr(b3 + 1) - 1)
ElseIf b3 <= m3 Then
TmpStr3 = Mid(计算式, Arr(b3) + 1, Arr(b3 + 1) - Arr(b3) - 1)
ElseIf b3 = m3 + 1 Then
TmpStr3 = Mid(计算式, Arr(b3) + 1, Arr(b3 + 1) - Arr(b3))
TmpValue3 = Application.Evaluate(TmpStr3)
Str3 = Str3 & TmpValue3
Exit For
End If
TmpValue3 = Application.Evaluate(TmpStr3)
Str3 = Str3 & TmpValue3 & Mid(计算式, Arr(b3 + 1), 1)
Next
计算式 = Str3 '更新计算式
End If
If VBA.Len(计算式) <= 255 Then GoTo 计算 '如果整理后的计算式长度小于等于255，则直接计算
'======================================简化计算式中的括号运算======================================
'若最后得到的计算式仍大于255字符，再进行简化，直到长度小于等于254字符
Dim TmpStr4$, TmpValue4 As Double
Dim m4%
Do
Do
m4 = m4 + 1
Loop Until InStr("+-", Mid(计算式, 255 - m4 + 1, 1)) > 0
TmpStr4 = VBA.Mid(计算式, 1, 255 - m4)
TmpValue4 = Application.Evaluate(TmpStr4)
计算式 = Application.Substitute(计算式, TmpStr4, TmpValue4)
m4 = 0 '计数器归零
Loop Until Len(计算式) <= 255 '直到计算式长度≤255，才退出循环
GoTo 计算
'=======================================计算结果=======================================
计算:
If VBA.IsError(Application.Evaluate(计算式)) Then '若计算式有误，结果为错
MyValue = "错"
Else
MyValue = Application.Round(Application.Evaluate(计算式), Point)
End If
End Function

复制代码

shmylovei · 发表于 2021-10-8 15:56

膜拜大神学习了

lipton · 发表于 2021-10-8 19:32

用逆波兰表达式或许更简单一点

岁月无恒 · 发表于 2021-10-10 02:25

lipton 发表于 2021-10-8 19:32
用逆波兰表达式或许更简单一点

逆波兰表达式视觉上不太直观，但是逆波兰表达式计算结果确实更简单，但是，将普通计算式转换为逆波兰表达式，也不简单。

mythqiu · 发表于 2022-1-17 18:46

我发现一个简便的方法，将纯计算式字符加个等号写在工程量表格就对了。
=2+3-5/2+3*2*(1+1+2)

kfhgng · 发表于 2022-12-21 16:49

你好！
这代码对超长计算式或其它，能不能用上
谢谢！

kfhgng · 发表于 2022-12-22 08:34

你好！
7楼，这代码对超长计算式或其它，能不能用上
谢谢！

gwenrong · 发表于 2023-11-30 14:58

楼主我还是解决不了，

gwenrong · 发表于 2023-11-30 15:01

楼主请教个问

结果还是无法显示

		自动登录	找回密码
密码			免费注册

[分享] 关于EXCEL超长计算式的解决方案

评分