[VBA]公式解析源代码，仅包含四则运算部分。

efan2000

花了两天时间，终于将一个C#编写的公式解析程序转化为VB的代码，不过还有很多东西没有实现，比如函数和变量功能的实现，有兴趣的可以自己研究，也可以参考编译原理这本书。

2. 
   
3. Enum tokTypes
   
4.     tokNONE = 0
   
5.     tokDELIMITER = 1
   
6.     tokVARIABLE = 2
   
7.     tokFUNCTION = 3
   
8.     tokNumber = 4
   
9.     tokString = 5
   
10. End Enum
    
11. Dim exp As String
    
12. Dim expIdx As Integer
    
13. Dim token As String
    
14. Dim tokType As tokTypes
    
15. 
    
16. ' 判断是否指定的分隔符
    
17. Function IsDelim(ByVal c As String) As Boolean
    
18.     If InStr("+-*/&()", c) Then IsDelim = True
    
19. End Function
    
20. 
    
21. ' 判断是否是字母
    
22. Function IsLetter(ByVal c As String) As Boolean
    
23.     If Asc(c) >= 65 And Asc(c) <= 90 Then
    
24.         IsLetter = True
    
25.     ElseIf Asc(c) >= 97 And Asc(c) <= 122 Then
    
26.         IsLetter = True
    
27.     End If
    
28. End Function
    
29. 
    
30. '判断是否是数字
    
31. Function IsDigit(ByVal c As String) As Boolean
    
32.     If Asc(c) >= 48 And Asc(c) <= 57 Then IsDigit = True
    
33. End Function
    
34. 
    
35. '判断是否是空格
    
36. Function IsWhiteSpace(ByVal c As String) As Boolean
    
37.     If c = " " Then IsWhiteSpace = True
    
38. End Function
    
39. 
    
40. '取计算单元标记
    
41. Sub GetToken()
    
42.     tokType = tokNONE
    
43.     token = ""
    
44.     If expIdx > Len(exp) Then Exit Sub
    
45.     '忽略前置空格
    
46.     Do While (expIdx <= Len(exp) And IsWhiteSpace(Mid(exp, expIdx, 1)))
    
47.         expIdx = expIdx + 1
    
48.         If expIdx > Len(exp) Then Exit Sub
    
49.     Loop
    
50.     '分隔符
    
51.     If (IsDelim(Mid(exp, expIdx, 1))) Then
    
52.         token = token + Mid(exp, expIdx, 1)
    
53.         expIdx = expIdx + 1
    
54.         tokType = tokDELIMITER
    
55.     '函数或者变量
    
56.     ElseIf (IsLetter(Mid(exp, expIdx, 1))) Then
    
57.        token = token + Mid(exp, expIdx, 1)
    
58.         expIdx = expIdx + 1
    
59.         If expIdx > Len(exp) Then Exit Sub
    
60.         Do While (IsLetter(Mid(exp, expIdx, 1)) And IsDigit(Mid(exp, expIdx, 1)))
    
61.             token = token + Mid(exp, expIdx, 1)
    
62.             expIdx = expIdx + 1
    
63.             If expIdx > Len(exp) Then Exit Do
    
64.         Loop
    
65.         tokType = tokFUNCTION
    
66.     '数字
    
67.     ElseIf (IsDigit(Mid(exp, expIdx, 1))) Then
    
68.         Do While Not (IsDelim(Mid(exp, expIdx, 1)))
    
69.             token = token + Mid(exp, expIdx, 1)
    
70.             expIdx = expIdx + 1
    
71.             If expIdx > Len(exp) Then Exit Do
    
72.         Loop
    
73.         tokType = tokNumber
    
74.     '字符串
    
75.     ElseIf (Mid(exp, expIdx, 1) = """") Then
    
76.         expIdx = expIdx + 1
    
77.         Do While (Mid(exp, expIdx, 1) <> """")
    
78.             token = token + Mid(exp, expIdx, 1)
    
79.             expIdx = expIdx + 1
    
80.             If expIdx > Len(exp) Then Exit Do
    
81.         Loop
    
82.         expIdx = expIdx + 1
    
83.         tokType = tokString
    
84.     End If
    
85. End Sub
    
86. 
    
87. Function Evaluate(ByVal expstr As String)
    
88.     exp = expstr
    
89.     expIdx = 1
    
90.     GetToken
    
91.     If (tokType = tokNONE And token = """") Then MsgBox ("No Expression Present!")
    
92.     Evaluate = EvalExp2()
    
93.     MsgBox Evaluate
    
94. End Function
    
95. 
    
96. '处理加法或减法
    
97. Function EvalExp2() As String
    
98.     Dim result As String
    
99.     Dim op As String
    
100.     Dim partialResult As String
     
101.     EvalExp2 = EvalExp3()
     
102.     op = token
     
103.     Do While (op = "+" Or op = "-" Or op = "&")
     
104.         GetToken
     
105.         partialResult = EvalExp3()
     
106.         Select Case op
     
107.             Case "-":
     
108.                 EvalExp2 = CDbl(EvalExp2) - CDbl(partialResult)
     
109.             Case "+":
     
110.                 EvalExp2 = CDbl(EvalExp2) + CDbl(partialResult)
     
111.             Case "&":
     
112.                 EvalExp2 = EvalExp2 + partialResult
     
113.         End Select
     
114.         op = token
     
115.     Loop
     
116. End Function
     
117. 
     
118. '处理乘法或除法
     
119. Function EvalExp3() As String
     
120.     Dim op As String
     
121.     Dim partialResult  As String
     
122.     EvalExp3 = EvalExp5
     
123.     op = token
     
124.     Do While (op = "*" Or op = "/")
     
125.         GetToken
     
126.         partialResult = EvalExp5
     
127.         Select Case op
     
128.             Case "*":
     
129.                 EvalExp3 = CDbl(EvalExp3) * CDbl(partialResult)
     
130.             Case "/":
     
131.                 EvalExp3 = CDbl(EvalExp3) / CDbl(partialResult)
     
132.         End Select
     
133.         op = token
     
134.     Loop
     
135. End Function
     
136. 
     
137. '处理一元
     
138. Function EvalExp5() As String
     
139.     Dim op As String
     
140.     Dim partialResult  As String
     
141.     op = ""
     
142.     If ((tokType = tokDELIMITER) And (token = "+" Or token = "-")) Then
     
143.         op = token
     
144.         GetToken
     
145.     End If
     
146.     EvalExp5 = EvalExp6
     
147.     If (op = "-") Then EvalExp5 = -1 * EvalExp5
     
148. End Function
     
149. 
     
150. '处理括号
     
151. Function EvalExp6() As String
     
152.     If ((token = "(")) Then
     
153.         GetToken
     
154.         EvalExp6 = EvalExp2()
     
155.         GetToken
     
156.     Else
     
157.         EvalExp6 = Atom()
     
158.     End If
     
159. End Function
     
160. 
     
161. '处理数字或字符串
     
162. Function Atom() As String
     
163.     Select Case tokType
     
164.         Case tokNumber:
     
165.             Atom = token
     
166.             GetToken
     
167.         Case tokString:
     
168.             Atom = token
     
169.             GetToken
     
170.     End Select
     
171. End Function
     
172. 
     
173. Sub main()
     
174.     Evaluate "3+5*(2.5+7.5)-8/2"
     
175. End Sub
     

<br /> Enum tokTypes<br />     tokNONE = 0<br />     tokDELIMITER = 1<br />     tokVARIABLE = 2<br />     tokFUNCTION = 3<br />     tokNumber = 4<br />     tokString = 5<br /> End Enum<br /> Dim exp As String<br /> Dim expIdx As Integer<br /> Dim token As String<br /> Dim tokType As tokTypes<br /> <br /> ' 判断是否指定的分隔符<br /> Function IsDelim(ByVal c As String) As Boolean<br />     If InStr("+-*/&()", c) Then IsDelim = True<br /> End Function<br /> <br /> ' 判断是否是字母<br /> Function IsLetter(ByVal c As String) As Boolean<br />     If Asc(c) >= 65 And Asc(c) <= 90 Then<br />         IsLetter = True<br />     ElseIf Asc(c) >= 97 And Asc(c) <= 122 Then<br />         IsLetter = True<br />     End If<br /> End Function<br /> <br /> '判断是否是数字<br /> Function IsDigit(ByVal c As String) As Boolean<br />     If Asc(c) >= 48 And Asc(c) <= 57 Then IsDigit = True<br /> End Function<br /> <br /> '判断是否是空格<br /> Function IsWhiteSpace(ByVal c As String) As Boolean<br />     If c = " " Then IsWhiteSpace = True<br /> End Function<br /> <br /> '取计算单元标记<br /> Sub GetToken()<br />     tokType = tokNONE<br />     token = ""<br />     If expIdx > Len(exp) Then Exit Sub<br />     '忽略前置空格<br />     Do While (expIdx <= Len(exp) And IsWhiteSpace(Mid(exp, expIdx, 1)))<br />         expIdx = expIdx + 1<br />         If expIdx > Len(exp) Then Exit Sub<br />     Loop<br />     '分隔符<br />     If (IsDelim(Mid(exp, expIdx, 1))) Then<br />         token = token + Mid(exp, expIdx, 1)<br />         expIdx = expIdx + 1<br />         tokType = tokDELIMITER<br />     '函数或者变量<br />     ElseIf (IsLetter(Mid(exp, expIdx, 1))) Then<br />        token = token + Mid(exp, expIdx, 1)<br />         expIdx = expIdx + 1<br />         If expIdx > Len(exp) Then Exit Sub<br />         Do While (IsLetter(Mid(exp, expIdx, 1)) And IsDigit(Mid(exp, expIdx, 1)))<br />             token = token + Mid(exp, expIdx, 1)<br />             expIdx = expIdx + 1<br />             If expIdx > Len(exp) Then Exit Do<br />         Loop<br />         tokType = tokFUNCTION<br />     '数字<br />     ElseIf (IsDigit(Mid(exp, expIdx, 1))) Then<br />         Do While Not (IsDelim(Mid(exp, expIdx, 1)))<br />             token = token + Mid(exp, expIdx, 1)<br />             expIdx = expIdx + 1<br />             If expIdx > Len(exp) Then Exit Do<br />         Loop<br />         tokType = tokNumber<br />     '字符串<br />     ElseIf (Mid(exp, expIdx, 1) = """") Then<br />         expIdx = expIdx + 1<br />         Do While (Mid(exp, expIdx, 1) <> """")<br />             token = token + Mid(exp, expIdx, 1)<br />             expIdx = expIdx + 1<br />             If expIdx > Len(exp) Then Exit Do<br />         Loop<br />         expIdx = expIdx + 1<br />         tokType = tokString<br />     End If<br /> End Sub<br /> <br /> Function Evaluate(ByVal expstr As String)<br />     exp = expstr<br />     expIdx = 1<br />     GetToken<br />     If (tokType = tokNONE And token = """") Then MsgBox ("No Expression Present!")<br />     Evaluate = EvalExp2()<br />     MsgBox Evaluate<br /> End Function<br /> <br /> '处理加法或减法<br /> Function EvalExp2() As String<br />     Dim result As String<br />     Dim op As String<br />     Dim partialResult As String<br />     EvalExp2 = EvalExp3()<br />     op = token<br />     Do While (op = "+" Or op = "-" Or op = "&")<br />         GetToken<br />         partialResult = EvalExp3()<br />         Select Case op<br />             Case "-":<br />                 EvalExp2 = CDbl(EvalExp2) - CDbl(partialResult)<br />             Case "+":<br />                 EvalExp2 = CDbl(EvalExp2) + CDbl(partialResult)<br />             Case "&":<br />                 EvalExp2 = EvalExp2 + partialResult<br />         End Select<br />         op = token<br />     Loop<br /> End Function<br /> <br /> '处理乘法或除法<br /> Function EvalExp3() As String<br />     Dim op As String<br />     Dim partialResult  As String<br />     EvalExp3 = EvalExp5<br />     op = token<br />     Do While (op = "*" Or op = "/")<br />         GetToken<br />         partialResult = EvalExp5<br />         Select Case op<br />             Case "*":<br />                 EvalExp3 = CDbl(EvalExp3) * CDbl(partialResult)<br />             Case "/":<br />                 EvalExp3 = CDbl(EvalExp3) / CDbl(partialResult)<br />         End Select<br />         op = token<br />     Loop<br /> End Function<br /> <br /> '处理一元<br /> Function EvalExp5() As String<br />     Dim op As String<br />     Dim partialResult  As String<br />     op = ""<br />     If ((tokType = tokDELIMITER) And (token = "+" Or token = "-")) Then<br />         op = token<br />         GetToken<br />     End If<br />     EvalExp5 = EvalExp6<br />     If (op = "-") Then EvalExp5 = -1 * EvalExp5<br /> End Function<br /> <br /> '处理括号<br /> Function EvalExp6() As String<br />     If ((token = "(")) Then<br />         GetToken<br />         EvalExp6 = EvalExp2()<br />         GetToken<br />     Else<br />         EvalExp6 = Atom()<br />     End If<br /> End Function<br /> <br /> '处理数字或字符串<br /> Function Atom() As String<br />     Select Case tokType<br />         Case tokNumber:<br />             Atom = token<br />             GetToken<br />         Case tokString:<br />             Atom = token<br />             GetToken<br />     End Select<br /> End Function<br /> <br /> Sub main()<br />     Evaluate "3+5*(2.5+7.5)-8/2"<br /> End Sub<br />

efan2000

附上它的代码分析程序，是C#格式，可以参考。
没接触过C#的编程，可能转化的过程当中有些不是处理的很好，另外错误分析的部分也没处理。
附件是用WinRAR3.20版本压缩的，如果打不开，请下载新的版本。

myfreemind

好东西啊~~送花一朵！

王咣生

好程序呀!

jordan

确实很好啊.谢谢啊.

zcw840421

不错

cxs259

谢谢

chenyangkou

好东西大家分享

wangrong0820

为啥看不到呢?

\

goodwg

在哪里啊