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

efan2000 发表于 2003-11-20 21:23:00

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

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

Enum tokTypes
    tokNONE = 0
    tokDELIMITER = 1
    tokVARIABLE = 2
    tokFUNCTION = 3
    tokNumber = 4
    tokString = 5
End Enum
Dim exp As String
Dim expIdx As Integer
Dim token As String
Dim tokType As tokTypes

' 判断是否指定的分隔符
Function IsDelim(ByVal c As String) As Boolean
    If InStr("+-*/&()", c) Then IsDelim = True
End Function

' 判断是否是字母
Function IsLetter(ByVal c As String) As Boolean
    If Asc(c) >= 65 And Asc(c) <= 90 Then
      IsLetter = True
    ElseIf Asc(c) >= 97 And Asc(c) <= 122 Then
      IsLetter = True
    End If
End Function

'判断是否是数字
Function IsDigit(ByVal c As String) As Boolean
    If Asc(c) >= 48 And Asc(c) <= 57 Then IsDigit = True
End Function

'判断是否是空格
Function IsWhiteSpace(ByVal c As String) As Boolean
    If c = " " Then IsWhiteSpace = True
End Function

'取计算单元标记
Sub GetToken()
    tokType = tokNONE
    token = ""
    If expIdx > Len(exp) Then Exit Sub
    '忽略前置空格
    Do While (expIdx <= Len(exp) And IsWhiteSpace(Mid(exp, expIdx, 1)))
      expIdx = expIdx + 1
      If expIdx > Len(exp) Then Exit Sub
    Loop
    '分隔符
    If (IsDelim(Mid(exp, expIdx, 1))) Then
      token = token + Mid(exp, expIdx, 1)
      expIdx = expIdx + 1
      tokType = tokDELIMITER
    '函数或者变量
    ElseIf (IsLetter(Mid(exp, expIdx, 1))) Then
       token = token + Mid(exp, expIdx, 1)
      expIdx = expIdx + 1
      If expIdx > Len(exp) Then Exit Sub
      Do While (IsLetter(Mid(exp, expIdx, 1)) And IsDigit(Mid(exp, expIdx, 1)))
            token = token + Mid(exp, expIdx, 1)
            expIdx = expIdx + 1
            If expIdx > Len(exp) Then Exit Do
      Loop
      tokType = tokFUNCTION
    '数字
    ElseIf (IsDigit(Mid(exp, expIdx, 1))) Then
      Do While Not (IsDelim(Mid(exp, expIdx, 1)))
            token = token + Mid(exp, expIdx, 1)
            expIdx = expIdx + 1
            If expIdx > Len(exp) Then Exit Do
      Loop
      tokType = tokNumber
    '字符串
    ElseIf (Mid(exp, expIdx, 1) = """") Then
      expIdx = expIdx + 1
      Do While (Mid(exp, expIdx, 1) <> """")
            token = token + Mid(exp, expIdx, 1)
            expIdx = expIdx + 1
            If expIdx > Len(exp) Then Exit Do
      Loop
      expIdx = expIdx + 1
      tokType = tokString
    End If
End Sub

Function Evaluate(ByVal expstr As String)
    exp = expstr
    expIdx = 1
    GetToken
    If (tokType = tokNONE And token = """") Then MsgBox ("No Expression Present!")
    Evaluate = EvalExp2()
    MsgBox Evaluate
End Function

'处理加法或减法
Function EvalExp2() As String
    Dim result As String
    Dim op As String
    Dim partialResult As String
    EvalExp2 = EvalExp3()
    op = token
    Do While (op = "+" Or op = "-" Or op = "&")
      GetToken
      partialResult = EvalExp3()
      Select Case op
            Case "-":
                EvalExp2 = CDbl(EvalExp2) - CDbl(partialResult)
            Case "+":
                EvalExp2 = CDbl(EvalExp2) + CDbl(partialResult)
            Case "&":
                EvalExp2 = EvalExp2 + partialResult
      End Select
      op = token
    Loop
End Function

'处理乘法或除法
Function EvalExp3() As String
    Dim op As String
    Dim partialResultAs String
    EvalExp3 = EvalExp5
    op = token
    Do While (op = "*" Or op = "/")
      GetToken
      partialResult = EvalExp5
      Select Case op
            Case "*":
                EvalExp3 = CDbl(EvalExp3) * CDbl(partialResult)
            Case "/":
                EvalExp3 = CDbl(EvalExp3) / CDbl(partialResult)
      End Select
      op = token
    Loop
End Function

'处理一元
Function EvalExp5() As String
    Dim op As String
    Dim partialResultAs String
    op = ""
    If ((tokType = tokDELIMITER) And (token = "+" Or token = "-")) Then
      op = token
      GetToken
    End If
    EvalExp5 = EvalExp6
    If (op = "-") Then EvalExp5 = -1 * EvalExp5
End Function

'处理括号
Function EvalExp6() As String
    If ((token = "(")) Then
      GetToken
      EvalExp6 = EvalExp2()
      GetToken
    Else
      EvalExp6 = Atom()
    End If
End Function

'处理数字或字符串
Function Atom() As String
    Select Case tokType
      Case tokNumber:
            Atom = token
            GetToken
      Case tokString:
            Atom = token
            GetToken
    End Select
End Function

Sub main()
    Evaluate "3+5*(2.5+7.5)-8/2"
End Sub

efan2000 发表于 2003-11-20 21:30:00

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

myfreemind 发表于 2004-1-19 22:28:00

好东西啊~~送花一朵！

王咣生 发表于 2004-2-6 21:14:00

好程序呀

好程序呀!

jordan 发表于 2006-4-21 00:34:00

确实很好啊.谢谢啊.

zcw840421 发表于 2008-10-17 17:38:00

<strong>不错</strong>

cxs259 发表于 2009-4-2 09:25:00

谢谢

chenyangkou 发表于 2009-10-10 12:09:00

<p>好东西大家分享</p>

wangrong0820 发表于 2009-10-15 18:53:00

<p>为啥看不到呢?</p><p>\</p>

goodwg 发表于 2009-11-8 16:59:00

<p>在哪里啊</p><p></p>

查看完整版本: [VBA]公式解析源代码，仅包含四则运算部分。