表达式求值自定义函数突破255字符限制并兼容64位office

ggmmlol

工程量计算式求值，是工程量计算表的一项基础功能，是EXCEL在工程行业应用中的一个小难题。为解决这个问题，不少人想了各种各样的办法。

方法一、最早的Evaluate宏表函数+定义名称的办法，简单易用，流传颇广，但有一个明显的局限：受Evaluate宏表函数的限制，表达式的字符串长度不能超过255个字符，而且由于注释字符的转换会额外增加字符数量，导致表达式的字符数量甚至经常不能超过200个字符，否则就会出错。

方法二、针对方法一中的注释字符的影响，使用VBA做相应的改进：在用Evaluate求值之前，通过自定义函数先得到去除了注释内容的“纯净”的表达式，这样就可以保证计算式中有效长度最大可以达到255个字符的上限。此方法可以在自定义函数中使用宏表函数Evaluate，因此可以免去自定义名称的麻烦，但仍然没有完全突破字符长度的限制。

方法三、由于Evaluate宏表函数的参数长度不能超过255字符，是其本身的固有局限，要想完全突破字符长度限制，又进化出两种改进办法：一种是完全放弃Evaluate函数，改用vbs或js的Eval函数方法来求值。另一种是，对表达式做分段拆分，然后分别用Evaluate函数求值。

这两个改进方法中，后者需要准确合理的拆分计算式，其实是有相当的技术难度的，因为这相当于重新编写一个增强的Evaluate函数，因此能完美实现的很少，样例也很少；
而前者，需用Msscriptcontrol控件作为vbs代码或js代码的容器，才能让eval函数发挥作用，但这里涉及的步骤和代码并不复杂，于是成为新的潮流，而且由于Eval函数不限制参数长度，几乎就是完美的解决方案了。

之所以说“几乎”，因为它又带来了另一个局限：Msscriptcontrol控件是在32位office时代开发的，它只能应用在32位office环境中，而不能适用于64位office环境，之后微软并没有提供相应的64位控件。这个不足之处，在几年之前还算不上多大的缺限，因为那时候使用64位office的人员所占比例不大。但是，随着软硬件的快速更新换代，现在使用的电脑，主流OS平台一般都是64位的win7或win10了，其应用系统和办公软件也快速进入64位时代，于是32位旧代码如何适应新的64位office软件平台的问题就急切需要解决了。

方法四、
要解决方法三中使用32位的Msscriptcontrol控件在64位office平台上的兼容问题，首先想到的就是使用该控件的64位版本，但微软明显不愿意再提供此控件的64位版本，而且也没有第三方愿意做这样的事情，那么就只能由用户自行想办法解决了。

这种情况下，有的是制作dll格式的自定义函数文件，有的根据EXCEL的事件代码编写加载宏，在表达式输入完成时自动将其转换成Excel公式来完成计算。制作dll格式的自定义函数文件，需要有一些VB或VC软件开发经验，一般VBA爱好者都望而却步；而用EXCEL的内置事件驱动的自动宏代码，不如自定义函数代码便于移植。

而我，偶然想到，方法三中，作为vbs或js代码容器的msscriptcontrol控件，存在着不能跨平台的限制，但vbs或js本身却是可以跨平台的脚本语言，只要为它们重新找一个可以与平台无关的容器，或许问题就能够解决。再又想到html文档也可以作为vbs或js代码的容器，而html文档显然是可以跨32位和64位平台的。

就此，找到了一个突破口，写成了一个自认为还不错的计算式求值的VBA自定义函数：EEVAL，然后又几经改进，于是就有了这个主题贴，和下面的附件，特此与大家共享:

1. Option Explicit
   
2. Dim oReg As New RegExp
   
3. 
   
4. Function EEVAL(ByVal s$) As Double '计算复杂文本描述型表达式的值 利用正则消除无效字符 JS eval计算超长计算式
   
5.     Dim a$, b$, i%, oDom As Object, oWin As Object, strJS$
   
6.     a = "＋－×÷（）"
   
7.     b = "+-*/()"
   
8.     For i = 1 To 6
   
9.         s = Replace(s, Mid(a, i, 1), Mid(b, i, 1))
   
10.     Next
    
11.     s = VBA.LCase(s)
    
12.     With oReg
    
13.         .Global = True
    
14.         .IgnoreCase = True
    
15.         .Pattern = "(\w+(?:\([^\(\)]*\))?)\^(\w+(?:\([^\(\)]*\))?)"
    
16.         s = .Replace(s, "pow($1,$2)") '支持幂运算符
    
17.         .Pattern = "\b(sqrt|round|random|pow(er)?|PI|min|max|log|Int|floor|exp|E|ceil|abs|a?tan2?|a?sin|a?cos)\b"
    
18.         s = .Replace(LCase(s), "Math.$1") '支持基本数学函数和两个重要常数（圆周率和自然常数）
    
19.         .Pattern = "\[[^\[\]]*\]|(Math\.)(?=\1)"
    
20.         s = .Replace(s, "")
    
21.         .Pattern = "\b(Math\.)?Int"
    
22.         s = .Replace(s, "parseInt") '支持Int函数
    
23.         .Pattern = "pow(er)?"
    
24.         s = .Replace(s, "pow")
    
25.         .Pattern = "Math.e\b"
    
26.         s = .Replace(s, "Math.E")
    
27.         .Pattern = "\.pi\(\)"
    
28.         s = .Replace(s, ".PI")
    
29.     End With
    
30.     Set oDom = CreateObject("htmlfile")
    
31.     Set oWin = oDom.parentWindow
    
32.     oDom.write Replace("<script Language = JavaScript> function eEvaluate(){return eexp} </script>", "eexp", s)
    
33.     EEVAL = oWin.eval("eEvaluate()")
    
34. End Function

复制代码

EXCEL算量表计算式求值自定义函数.rar (21.63 KB, 下载次数: 299)

2018-10-8 22:52 上传

点击文件名下载附件

补充内容 (2019-8-8 13:23):
更新：修正3处Bug。详见23楼。

ggmmlol

根据上面两位坛友反馈，修改代码，把Round、Ceiling和Floor这3个不常用的函数从支持的函数清单中移除，同时，把正则对象的Global和Ignorecase两项都改为在Auto_Open过程中统一赋值，避免在函数中重复执行。这样，函数的效率应当略有提升，继续测试反馈：
（2019-9-8补充：对连续出现的"+"、"-" 运算符的化简，放在最后进行，避免遗漏。）
（2019-9-9补充：修正Int函数对负数取整的错误；增加对TRUNC函数的支持。）

1. Option Explicit
   
2. Public oReg As New RegExp, Initialized As Boolean '需引用Microsoft VBScript Regular Expressions 5.5
   
3. Sub Auto_Open()
   
4.     With oReg
   
5.         .Global = True
   
6.         .IgnoreCase = True
   
7.     End With
   
8.     Initialized = True
   
9. End Sub
   
10. 
    
11. Function EEVAL(ByVal s$)  '计算复杂文本描述型表达式的值 利用正则消除注释字符（以成对的半角或全角方括号[]【】包含的内容）
    
12.     Dim a$(), b$(), i%, strJS$, tmp0$, tmp1$, oDom As Object, oWin As Object
    
13.     '支持基本数学函数和两个重要常数（圆周率和自然常数）支持Int函数，支持全角四则运算符和幂运算符，支持全角圆括号。同时支持常用对数函数LOG和自然对数函数LN，并与Excel的工作表函数LOG、LN函数保持一致。
    
14.     tmp0 = "\blog10e\b、\bln(?=10\b|2\b)、\blog\(、＋、－、×、÷、（、）、(\d*\.?\d+|\w*\([^\(\)]*\)|\w+)\^(-?\d*\.?\d+|\w*\([^\(\)]*\)|\w+)、" & _
    
15.             "\bTRUNC\b、\bInt\b、\b(sqrt|round|random|pow(er)?|PI|min|max|log(10E)?|ln(2|10)|exp|E|abs|a?tan2?|a?sin|a?cos)\b、" & _
    
16.             "\[[^\[\]]*\]|【[^【】]*】|(Math\.)(?=\1)、power\b、Math.e\b、\.pi(\(\))?、\b(Math\.)?ln\(、(-\+*-|\+)+(?=[\+\-])|[\+\-]+$、--"
    
17.             
    
18.     tmp1 = "LOG10E、LN、LOG10E*log(、+、-、*、/、(、)、pow($1,$2)、" & _
    
19.             "parseInt、Math.floor、Math.$1、、pow、Math.E、.PI、Math.log(、、+"
    
20.     If Not Initialized Then Auto_Open
    
21.     a = Split(tmp0, "、")
    
22.     b = Split(tmp1, "、")
    
23.     s = VBA.LCase(s)
    
24.     With oReg
    
25.         For i = 0 To UBound(a)
    
26.             .Pattern = a(i)
    
27.             s = .Replace(s, b(i))
    
28.         Next
    
29.         If Len(s) = 0 Then EEVAL = VBA.vbNullString: Exit Function
    
30.     End With
    
31.     Set oDom = CreateObject("htmlfile")
    
32.     Set oWin = oDom.parentWindow
    
33.     oDom.write Replace("<script Language = JavaScript> function EEVAL(){return eexp} </script>", "eexp", s)
    
34.     EEVAL = oWin.eval("EEVAL()")
    
35. End Function

复制代码

yunfei2018

支持下，留个记号。

ggmmlol

需要注意的是，在js语言中，其math对象的log方法，Math.log方法，相当于Excel工作表函数LN函数，
得到的是自然对数值，而Excel工作表函数log，得到的是常用对数值，两者是有区别的。js的Math对象中，没有与工作表函数LOG直接对应的函数。

为了保持与Excel工作表函数一致，对以上代码做出调整，使之同时支持自然对数函数LN和常用对数函数LOG，并用for循环以简化多次的逐一的正则替换改语句，更新后的代码如下：

1. Option Explicit
   
2. Dim oReg As New RegExp
   
3. 
   
4. Function EEVAL(ByVal s$) As Double '计算复杂文本描述型表达式的值 利用正则消除注释字符（以成对的半角或全角方括号[]【】包含的内容）
   
5.     Dim a$(), b$(), i%, oDom As Object, oWin As Object, strJS$, tmp0$, tmp1$
   
6.     '支持基本数学函数和两个重要常数（圆周率和自然常数）支持Int函数，支持全角四则运算符和幂运算符，支持全角圆括号。同时支持常用对数函数LOG和自然对数函数LN，并与Excel的工作表函数LOG、LN函数保持一致。
   
7.     tmp0 = "\blog10e\b、\bln(?=10\b|2\b)、\blog\(、＋、－、×、÷、（、）、(\w+(?:\([^\(\)]*\))?)\^(\w+(?:\([^\(\)]*\))?)、" & _
   
8.             "\b(sqrt|round|random|pow(er)?|PI|min|max|log(10E)?|ln(2|10)|Int|floor|exp|E|ceil|abs|a?tan2?|a?sin|a?cos)\b、" & _
   
9.             "【.*?】|\[[^\[\]]*\]|(Math\.)(?=\1)、\b(Math\.)?Int、power\b、Math.e\b、\.pi\(\)、\b(Math\.)?ln\("
   
10.     tmp1 = "LOG10E、LN、LOG10E*log(、+、-、*、/、(、)、pow($1,$2)、Math.$1、、parseInt、pow、Math.E、.PI、Math.log("
    
11.     a = Split(tmp0, "、")
    
12.     b = Split(tmp1, "、")
    
13.     s = VBA.LCase(s)
    
14.     With oReg
    
15.         .Global = True
    
16.         .IgnoreCase = True
    
17.         For i = 0 To UBound(a)
    
18.             .Pattern = a(i)
    
19.             s = .Replace(s, b(i))
    
20.         Next
    
21.     End With
    
22.     Set oDom = CreateObject("htmlfile")
    
23.     Set oWin = oDom.parentWindow
    
24.     oDom.write Replace("<script Language = JavaScript> function eEvaluate(){return eexp} </script>", "eexp", s)
    
25.     EEVAL = oWin.eval("eEvaluate()")
    
26. End Function
    

复制代码

新代码的效果如下，可以看到它已经支持LN函数。并且，LN和LOG函数与EXCEL相应的工作表函数的计算结果完全一致！此外，可以看到，单层括号内的字符数字超过255字符时，也同样是能够正确求值的。



EXCEL算量表计算式求值自定义函数.rar (22.39 KB, 下载次数: 172)

2018-10-9 09:57 上传

点击文件名下载附件

langzhiwen

楼主大人好  请问你这个怎么能实现  不加括号  只要是加的文本就不参与计算呢  能否改下代码 谢谢

ggmmlol

langzhiwen 发表于 2018-11-15 15:23
楼主大人好  请问你这个怎么能实现  不加括号  只要是加的文本就不参与计算呢  能否改下代码 谢谢

对注释文字使用明确的标识符，这是标准的做法。

如果你觉得手工逐项输入方括号很麻烦，可以使用我的另一款小工具，进行批量添加方括号。

演示如下：其中，

查找

([^\d.+*/^\(\)-]+)

替换为

[$1]

langzhiwen

楼主 请问方便加下你的qq吗   或者给我个你常在的qq群

lu6200

楼主，能不能添加注释使用不区分中英文中括号，纯汉字不用添加括号的代码呢    非常感谢，这个对于外出或者发送给他人使用相当有用
非常感谢

[309411]

计算式中有ceiling 函数的时候不能用

18945521

楼主的代码还是有点小小的问题：
我用最普通的EVALUATE可以计算我的公式，只不过不能超过255个字符，而你的好像有些公式都计算不了，我发出来，你试试。
（
  (
    ((11.5-9.4）*0.4+11.5)/2+((3.8-1.64）*0.4+3.8)/2
  )*2[侧面周长]*
  (
    sqrt((11.5-9.4）/2^2+1^2)-
    sqrt((11.5-9.4）*0.4/2^2+0.4^2)
  )[侧面高度]
）*0.08

ggmmlol

18945521 发表于 2019-1-12 17:07
楼主的代码还是有点小小的问题：
我用最普通的EVALUATE可以计算我的公式，只不过不能超过255个字符，而你 ...

你的说法完全不存在！