Evaluate已经突破255字符限制

fjfhjie

Evaluate已经突破255.zip (28.18 KB, 下载次数: 519)

2014-7-5 15:31 上传

点击文件名下载附件
加载宏

此函数可以计算超过255字符的计算式,且可以设置小数点后保留位数.
欢迎使用

1. '自动计算
   
2. Function tn(R As String, Optional n As Variant) As Variant
   
3. Dim i As Byte, PL As String, PR As String, PL2 As String, PR2 As String
   
4. 
   
5. R = StrConv(R, vbNarrow)                         '把计算式里的全角“（”、“）”都转化为半角“(”、“)”
   
6. R = Replace(R, "", "")
   
7. R = Replace(R, "÷", "/")
   
8. R = Replace(R, "×", "*")
   
9. For i = 0 To 1
   
10. If InStr(R, "[") > InStr(R, "]") Then GoTo a1
    
11. If InStr(R, "[") = 0 Then Exit For
    
12. R = Left(R, InStr(R, "[") - 1) & Right(R, Len(R) - InStr(R, "]"))
    
13. If InStr(R, "]") = 0 Then Exit For
    
14. i = 0
    
15. Next
    
16. 
    
17. If Len(R) > 255 Then GoTo a2
    
18. Zhuhanshu:
    
19. On Error GoTo a1
    
20. If IsMissing(n) Then
    
21. tn = Round(Evaluate(R), 3)
    
22.    Else
    
23.    If n = Int(n) Then
    
24.     tn = Round(Evaluate(R), n)
    
25.       Else
    
26.       GoTo a1
    
27.       End If
    
28. End If
    
29. 
    
30. If 1 = 2 Then
    
31. a1:
    
32. tn = "错误"
    
33. If R = "" Then tn = ""
    
34. If R = "密码" Then tn = "不能让你看"
    
35. End If
    
36. Exit Function
    
37. 
    
38. If 1 = 2 Then
    
39. a2:
    
40. On Error GoTo a1
    
41. If InStr(R, "(") = 0 Then GoTo a3
    
42. For i = 0 To 1
    
43. PL = Left(R, InStr(R, ")") - 1)
    
44. PR = Right(R, Len(R) - InStr(R, ")"))
    
45. PL2 = Left(PL, InStrRev(PL, "(") - 1)
    
46. PR2 = Right(PL, Len(PL) - InStrRev(PL, "("))
    
47. R = PL2 & Evaluate(PR2) & PR
    
48. If Len(R) <= 255 Then GoTo Zhuhanshu
    
49. If InStr(R, "(") = 0 Then GoTo a3
    
50. i = 0
    
51. Next
    
52. End If
    
53. If 1 = 2 Then   '无()时
    
54. a3:
    
55. On Error GoTo a1
    
56. If InStr(R, "+") = 0 And InStr(R, "-") = 0 Then GoTo a4
    
57. For i = 0 To 1
    
58. PL = Left(R, 255)
    
59. If InStrRev(PL, "+") > InStrRev(PL, "-") Then
    
60. PL2 = Left(PL, InStrRev(PL, "+") - 1)
    
61. R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "+") + 1)
    
62.    Else
    
63.    PL2 = Left(PL, InStrRev(PL, "-") - 1)
    
64.   R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "-") + 1)
    
65. End If
    
66. If Len(R) <= 255 Then GoTo Zhuhanshu
    
67. If InStr(R, "+") = 0 And InStr(R, "-") = 0 Then GoTo a4
    
68. i = 0
    
69. Next
    
70. End If
    
71. If 1 = 2 Then
    
72. a4:
    
73. On Error GoTo a1
    
74. For i = 0 To 1
    
75. PL = Left(R, 255)
    
76. If InStrRev(PL, "*") > InStrRev(PL, "/") Then
    
77. PL2 = Left(PL, InStrRev(PL, "*") - 1)
    
78. R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "*") + 1)
    
79.    Else
    
80.    PL2 = Left(PL, InStrRev(PL, "/") - 1)
    
81.   R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "/") + 1)
    
82. End If
    
83. If Len(R) <= 255 Then GoTo Zhuhanshu
    
84. i = 0
    
85. Next
    
86. End If
    
87. End Function
    

复制代码

补充内容 (2014-7-10 10:09):
如果这个对你有用,请看6楼,最新的

补充内容 (2014-7-25 13:03):
请看7楼,最新

补充内容 (2016-8-13 18:41):
如需要此功能的函数可以来这里下载
excel一列计算式一列结果函数tn()/人民币大写函数dx()
http://www.excelpx.com/thread-329088-1-1.html

fjfhjie

最新版

liucqa

1. '自动计算
   
2. Function tn(R As String)
   
3.     Dim i As Integer, PL As String, PR As String, PL2 As String, PR2 As String
   
4. 
   
5.     R = StrConv(R, vbNarrow)                         '把计算式里的全角“（”、“）”都转化为半角“(”、“)”
   
6.     R = Replace(R, "", "")
   
7.     R = Replace(R, "÷", "/")
   
8.     R = Replace(R, "×", "*")
   
9.     For i = 0 To 1
   
10.         If InStr(R, "[") > InStr(R, "]") Then GoTo a1
    
11.         If InStr(R, "[") = 0 Then Exit For
    
12.         R = Left(R, InStr(R, "[") - 1) & Right(R, Len(R) - InStr(R, "]"))
    
13.         If InStr(R, "]") = 0 Then Exit For
    
14.         i = 0
    
15.     Next
    
16. 
    
17.     If Len(R) > 255 Then GoTo a2
    
18. Zhuhanshu:
    
19.     On Error GoTo a1
    
20.     tn = Round(Evaluate(R), 3)
    
21.     If 1 = 2 Then
    
22. a1:
    
23.         tn = "错误"
    
24.         If R = "" Then tn = ""
    
25.         If R = "密码" Then tn = "不能让你看"
    
26.     End If
    
27.     Exit Function
    
28.     If 1 = 2 Then
    
29. a2:
    
30.         On Error GoTo a1
    
31.         If InStr(R, "(") = 0 Then GoTo a3
    
32.         For i = 0 To 1
    
33.             PL = Left(R, InStr(R, ")") - 1)
    
34.             PR = Right(R, Len(R) - InStr(R, ")"))
    
35.             PL2 = Left(PL, InStrRev(PL, "(") - 1)
    
36.             PR2 = Right(PL, Len(PL) - InStrRev(PL, "("))
    
37.             R = PL2 & Evaluate(PR2) & PR
    
38.             If Len(R) <= 255 Then GoTo Zhuhanshu
    
39.             If InStr(R, "(") = 0 Then GoTo a3    'and instr(R,"
    
40.             i = 0
    
41.         Next
    
42.     End If
    
43.     If 1 = 2 Then   '无()时
    
44. a3:
    
45.         On Error GoTo a1
    
46.         If InStr(R, "+") = 0 And InStr(R, "-") = 0 Then GoTo a4
    
47.         For i = 0 To 1
    
48.             PL = Left(R, 255)
    
49.             If InStrRev(PL, "+") > InStrRev(PL, "-") Then
    
50.                 PL2 = Left(PL, InStrRev(PL, "+") - 1)
    
51.                 R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "+") + 1)
    
52.             Else
    
53.                 PL2 = Left(PL, InStrRev(PL, "-") - 1)
    
54.                 R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "-") + 1)
    
55.             End If
    
56.             If Len(R) <= 255 Then GoTo Zhuhanshu
    
57.             If InStr(R, "+") = 0 And InStr(R, "-") = 0 Then GoTo a4
    
58.             i = 0
    
59.         Next
    
60.     End If
    
61.     If 1 = 2 Then
    
62. a4:
    
63.         On Error GoTo a1
    
64.         For i = 0 To 1
    
65.             PL = Left(R, 255)
    
66.             If InStrRev(PL, "*") > InStrRev(PL, "/") Then
    
67.                 PL2 = Left(PL, InStrRev(PL, "*") - 1)
    
68.                 R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "*") + 1)
    
69.             Else
    
70.                 PL2 = Left(PL, InStrRev(PL, "/") - 1)
    
71.                 R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "/") + 1)
    
72.             End If
    
73.             If Len(R) <= 255 Then GoTo Zhuhanshu
    
74.             i = 0
    
75.         Next
    
76.     End If
    
77. End Function
    

复制代码

liucqa

http://club.excelhome.net/thread-1046791-1-1.html

dajiahaoxinku12

这是什么理由啊？            业余就设置密码？？      

fjfhjie

dajiahaoxinku12 发表于 2014-7-5 06:41
这是什么理由啊？            业余就设置密码？？

把所有的代码贴出来了.

fjfhjie

Evaluate可以计算超过255字符的计算式.zip (28.62 KB, 下载次数: 347)

2014-7-10 09:58 上传

点击文件名下载附件

工程量计算式超过255,也不用担心,完全可以计算,欢迎使用

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
   
4.      If IsMissing(n) Then Else If n <> Int(n) Or n < 0 Then GoTo a4
   
5.      Do
   
6.         If InStr(R, "[") > InStr(R, "]") Then GoTo a4
   
7.         If InStr(R, "[") = 0 Then Exit Do
   
8.            PL = Left(R, InStr(R, "]") - 1)
   
9.            PR = Right(R, Len(R) - InStr(R, "]"))
   
10.            PL2 = Left(PL, InStrRev(PL, "[") - 1)
    
11.            R = PL2 & PR
    
12.         If InStr(R, "]") = 0 Then Exit Do
    
13.      Loop
    
14.         R = StrConv(R, vbNarrow)
    
15.         R = Replace(R, "K", "^(.5)")
    
16.         R = Replace(R, "F", "^(2)")
    
17.         R = Replace(R, "÷", "/")
    
18.         R = Replace(R, "×", "*")
    
19.      If Len(R) > 255 Then GoTo a1
    
20. Zhuhanshu:
    
21.      On Error GoTo a4
    
22.      If IsMissing(n) Then
    
23.         tn = Round(Evaluate(R), 3)
    
24.            Else
    
25.            tn = Round(Evaluate(R), n)
    
26.      End If
    
27.   Exit Function
    
28. 
    
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, ")") - 1)
    
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, "("))
    
39.         R = PL2 & Evaluate(PR2) & PR
    
40.         If Len(R) <= 255 Then GoTo Zhuhanshu
    
41.         If InStr(R, "(") = 0 Then GoTo a2
    
42.       Loop
    
43.      End If
    
44.      If 1 = 2 Then   '无()时
    
45. a2:
    
46.        On Error GoTo a4
    
47.        If InStr(R, "+") = 0 And InStr(R, "-") = 0 Then GoTo a3
    
48.        Do
    
49.           PL = Left(R, 255)
    
50.           If InStrRev(PL, "+") > InStrRev(PL, "-") Then
    
51.           PL2 = Left(PL, InStrRev(PL, "+") - 1)
    
52.           R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "+") + 1)
    
53.             Else
    
54.               PL2 = Left(PL, InStrRev(PL, "-") - 1)
    
55.               R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "-") + 1)
    
56.           End If
    
57.           If Len(R) <= 255 Then GoTo Zhuhanshu
    
58.           If InStr(R, "+") = 0 And InStr(R, "-") = 0 Then GoTo a3
    
59.         Loop
    
60.         End If
    
61.       If 1 = 2 Then
    
62. a3:
    
63.         On Error GoTo a4
    
64.         Do
    
65.            PL = Left(R, 255)
    
66.            If InStrRev(PL, "*") > InStrRev(PL, "/") Then
    
67.            PL2 = Left(PL, InStrRev(PL, "*") - 1)
    
68.            R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "*") + 1)
    
69.              Else
    
70.              PL2 = Left(PL, InStrRev(PL, "/") - 1)
    
71.              R = Evaluate(PL2) & Right(R, Len(R) - InStrRev(PL, "/") + 1)
    
72.            End If
    
73.            If Len(R) <= 255 Then GoTo Zhuhanshu
    
74.         Loop
    
75.       End If
    
76.      If 1 = 2 Then
    
77. a4:
    
78.         If R = "" Then tn = "" Else tn = "错误"
    
79.         If R = "密码" Then tn = "不能让你看"
    
80.      End If
    
81.   End Function
    

复制代码

fjfhjie

Evaluate可以计算超过255字符的计算式.zip (29.31 KB, 下载次数: 468)

2014-7-27 11:54 上传

点击文件名下载附件

最新,代码与之前有所不同,功能不变



补充内容 (2016-5-22 16:22):
13楼最新

tcsooy

感谢分享。去实验下

stmason

这个还是有局限，在式中不能使用INT、MOD等内置函数啊

stmason

借鉴修改一下，现在能用内置的INT等函数了，分享一下思路，这个代吗应该还有精简改进的空间滴