ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: fjfhjie

[分享] Evaluate已经突破255字符限制

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2015-9-1 00:14 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖已被收录到知识树中,索引项:文本处理和正则
借鉴修改一下,现在能用内置的INT等函数了,分享一下思路,这个代吗应该还有精简改进的空间滴
  1.   '自动计算
  2.   Function tn(R As String, Optional n As Variant) As Variant
  3.     Dim PL As String, PR As String, PL2 As String, PR2 As String, PL21 As String, PL22 As String
  4.     Dim PL2rl As Integer '+
  5.      If IsMissing(n) Then Else If n <> Int(n) Or n < 0 Then GoTo a4
  6.      Do
  7.         If InStr(R, "[") > InStr(R, "]") Then GoTo a4
  8.         If InStr(R, "[") = 0 Then Exit Do
  9.            PL = Left(R, InStr(R, "]") - 1)
  10.            PR = Right(R, Len(R) - InStr(R, "]"))
  11.            PL2 = Left(PL, InStrRev(PL, "[") - 1)
  12.            R = PL2 & PR
  13.         If InStr(R, "]") = 0 Then Exit Do
  14.      Loop
  15.         R = StrConv(R, vbNarrow)      '把计算式里的全角“(”、“)”都转化为半角“(”、“)”
  16.         R = Replace(R, "K", "^(.5)")
  17.         R = Replace(R, "F", "^(2)")
  18.         R = Replace(R, "÷", "/")
  19.         R = Replace(R, "×", "*")
  20.      If Len(R) > 255 Then GoTo a1
  21. Zhuhanshu:
  22.      On Error GoTo a4
  23.      If IsMissing(n) Then
  24.         tn = Round(Evaluate(R), 3)
  25.            Else
  26.            tn = Round(Evaluate(R), n)
  27.      End If
  28.   Exit Function
  29.      If 1 = 2 Then
  30. a1:
  31.      On Error GoTo a4
  32.      If InStr(R, "(") = 0 Then GoTo a2
  33.      Do
  34.         PL = Left(R, InStr(R, ")"))
  35.         PR = Right(R, Len(R) - InStr(R, ")"))
  36.         If IsNumeric(Left(PR, 1)) Or Left(PR, 1) = "(" Or Left(PR, 1) = "." Then GoTo a4
  37.         PL2 = Left(PL, InStrRev(PL, "(") - 1)
  38.         PR2 = Right(PL, Len(PL) - InStrRev(PL, "(") + 1)
  39.           If Right(PL2, 1) <> "*" Or Right(PL2, 1) <> "/" Or Right(PL2, 1) <> "+" Or Right(PL2, 1) <> "-" Then
  40.              PL2rl = Application.Max(InStrRev(PL2, "*"), InStrRev(PL2, "/"), InStrRev(PL2, "+"), InStrRev(PL2, "-")) '+
  41.              PL21 = Left(PL2, PL2rl) '+
  42.              PL22 = Right(PL2, Len(PL2) - PL2rl) '+
  43.              PL2 = PL21
  44.              PR2 = PL22 & PR2
  45.           End If
  46.         R = PL2 & Evaluate(PR2) & PR
  47.         If Len(R) <= 255 Then GoTo Zhuhanshu
  48.         If InStr(R, "(") = 0 Then GoTo a2
  49.       Loop
  50.      End If
  51.      If 1 = 2 Then   '无()时
  52. a2:
  53.        On Error GoTo a4
  54.        If InStr(R, "+") = 0 And InStr(R, "-") = 0 Then GoTo a3
  55.        Do
  56.           PL = Left(R, 255)
  57.           If InStrRev(PL, "+") > InStrRev(PL, "-") Then
  58.           PL2 = Left(PL, InStrRev(PL, "+") - 1)
  59.           R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "+") + 1)
  60.             Else
  61.               PL2 = Left(PL, InStrRev(PL, "-") - 1)
  62.               R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "-") + 1)
  63.           End If
  64.           If Len(R) <= 255 Then GoTo Zhuhanshu
  65.           If InStr(R, "+") = 0 And InStr(R, "-") = 0 Then GoTo a3
  66.         Loop
  67.         End If
  68.       If 1 = 2 Then
  69. a3:
  70.         On Error GoTo a4
  71.         Do
  72.            PL = Left(R, 255)
  73.            If InStrRev(PL, "*") > InStrRev(PL, "/") Then
  74.            PL2 = Left(PL, InStrRev(PL, "*") - 1)
  75.            R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "*") + 1)
  76.              Else
  77.              PL2 = Left(PL, InStrRev(PL, "/") - 1)
  78.              R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "/") + 1)
  79.            End If
  80.            If Len(R) <= 255 Then GoTo Zhuhanshu
  81.         Loop
  82.       End If
  83.      If 1 = 2 Then
  84. a4:
  85.         If R = "" Then tn = 0 Else tn = "错误"
  86.         If R = "密码" Then tn = "不能让你看"
  87.      End If
  88.   End Function
复制代码


TA的精华主题

TA的得分主题

发表于 2015-9-1 05:25 来自手机 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
stmason 发表于 2015-9-1 00:02
借鉴修改一下,现在能用内置的INT等函数了,分享一下思路,这个代吗应该还有精简改进的空间滴

上传代码,分享成果!!

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-5-22 10:40 | 显示全部楼层
本帖最后由 fjfhjie 于 2016-5-22 10:42 编辑

根据9楼建议,11楼方法完善此函数。此次上传加载宏xlam版与自动化加载项DLL版,两个版代码相同。如有需要自行下载

补充内容 (2016-6-30 11:52):
自动化加载项dll版,好像只能在office2010 32位中使用。

自定义函数Xlam.zip

29.91 KB, 下载次数: 194

自定义函数dll.zip

94.64 KB, 下载次数: 98

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-6-25 17:11 | 显示全部楼层

计算表达式tn函数

本帖最后由 fjfhjie 于 2016-6-25 17:19 编辑

此次上传加载宏xll版。office 2003、2007、2010、2013、2016  32位版本以及wps均可使用(但精简版不可以用)!但必须在安装了.net framework 4.0才可以使用。此自定义函数是用vbScript计算的,所以只能在32位的excel中用,且计算式有出现excel内置函数时不可以计算(但是可以计算int取整函数,别的不可以)!!

补充内容 (2016-7-2 11:18):
office2003加载可以计算,关闭后,打开excel会一直提示错误,故office2003中不可使用

自定义函数xll.zip

163.53 KB, 下载次数: 59

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-8-5 16:35 | 显示全部楼层

excel一列计算式一列结果函数tn()/人民币大写函数dx()

本帖最后由 fjfhjie 于 2016-8-6 20:31 编辑

excel计算表达式函数.zip (319.03 KB, 下载次数: 90)
此次上传加载宏xll版,其中有两个自定义函数(计算表达试函数tn()/人民币大写函数dx())。
2007、2010、2013、2016  32位&64位office版本以及wps均可使用(但精简版不可以用)!
但必须在安装了.net framework 4.0才可以使用
且tn()函数计算式中可以有mod/int等一些函数。
本加载宏是用ExcelDna封装的,附有代码。如有错误,欢迎指正。




补充内容 (2016-8-13 17:00):
此版本发现错误,计算表达式函数tn(),有些正确的计算式不能得出结果。特此说明。
如果有需要可以来这里下载
http://www.excelpx.com/thread-329088-1-1.html
这里的是已经修复好的!!!

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-9-1 18:38 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
excel计算表达式函数2016.08.13.zip (319.92 KB, 下载次数: 102)

补充内容 (2016-10-12 20:08):
22楼,最新

TA的精华主题

TA的得分主题

发表于 2016-9-13 10:23 | 显示全部楼层
老师你好,有没有时间,帮我编写一个 数 值 转 换 大 写 代 码 吗?

数值转大写 .rar

2.48 KB, 下载次数: 30

TA的精华主题

TA的得分主题

发表于 2016-9-13 18:10 | 显示全部楼层
fjfhjie 发表于 2016-8-5 16:35
此次上传加载宏xll版,其中有两个自定义函数(计算表达试函数tn()/人民币大写函数dx())。
2007、2010、 ...

砼浇筑计划跟进表.rar (18.93 KB, 下载次数: 120) 没有必要搞那么复杂。
对于计算式中的注释文字,使用正则表达式将其判别出来并删除掉,然后用Change事件触发的自动宏,在计算结果的单元格中自动填写公式,并进一步转化为值即可。
因为上述方法采用的完全是EXCEL公式本身的计算功能,当然就不受Evaluate字符数限制,而计算式也如同普通公式一样,可包含任意EXCEL内置函数、自定义函数、名称定义(可以用来自定义代号),而且通用于32位和64位的EXCEL2003及以上的任意版本,无需.net framework即可使用。
简单说来,就是用自动宏完成3个步骤:①清除计算式中注释内容;②为计算式添加“=”号,使之成为普通公式;③把公式转换为数值。


评分

3

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-9-23 19:09 | 显示全部楼层
本帖最后由 fjfhjie 于 2016-9-23 19:11 编辑
cbtaja 发表于 2016-9-13 18:10
没有必要搞那么复杂。
对于计算式中的注释文字,使用正则表达式将其判别出来并删除掉,然后用Change事件 ...

搞的复杂吗?我恰恰是从加载方便,使用简单的角度出发才弄的这个
或许你这个从计算式转化成值代码写的比较简单,但是在我们专业里你写的这个实用性几乎为零,无实用性价值。
你这只限定在这张表格中使用,而在我们专业里,有计算式的表不可能只是这一种样式。你把计算式限定在第5列,结果限定在6列,是不现实的。当然你这个也可以改代码来实现,计算式不在第5列,结果也在其它列,但那必须有点VBA基础的人才能用,但是话说回来了,懂vba的人会用到你写的这个东西吗?
而且触发自动宏事件,撤销功能就没有了
综上所述,你写的这个实用性不强

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-9-23 19:20 | 显示全部楼层
huangxuejin 发表于 2016-9-13 10:23
老师你好,有没有时间,帮我编写一个 数 值 转 换 大 写 代 码 吗?

LBC转大写.zip (9.77 KB, 下载次数: 63)
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-5-2 18:04 , Processed in 0.051941 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表