如何计算公式?

Question

在Text1中输入 12 * 2 - 5 * (3 / 4)
按Command1计算结果,在Text2里显示

Answer 1

加减乘除的偶有一个现成的，更多其它运算符的就不支持了：'执行表达式计算
Function GetVal(ByVal c As String) As String
    c = ConvChs(c)
    GetVal = chkStr(c)
    If GetVal = "" Then GetVal = GetExp(c)
    If IsNumeric(GetVal) Then GetVal = FormatNumber(GetVal, , , , vbFalse)
End Function'解析
Private Function GetExp(str1 As String) As String
    Dim Val1, Val2, Op1, Op2, Val3, NewVal
    Val1 = GetValue(str1)
    NewVal = Val1
    Op1 = ReadOp(str1)
    Do While Op1 <> ""
        Val2 = GetValue(str1)
        Op2 = ReadOp(str1)
        Do While Op2 <> ""
            If (Op2 = "*" Or Op2 = "/" Or Op2 = "\") And (Op1 = "-" Or Op1 = "+") Then
                Val3 = GetValue(str1)
                Val2 = CompStr(Val2, Op2, Val3)
                Op2 = ReadOp(str1)
            Else
                Exit Do
            End If
        Loop
        NewVal = CompStr(NewVal, Op1, Val2)
        Op1 = Op2
    Loop
    
    If Trim(NewVal) = "" Then
        GetExp = "运算式有错误。"
    Else
        GetExp = IIf(ErrorStr = "", NewVal, ErrorStr)
    End If
End Function'处理中文运算符
Private Function ConvChs(ByVal c As String) As String
    Const C1 = "×÷[]{}"
    Const C2 = "*/()()"    ConvChs = StrConv(c, vbNarrow)
    Dim i As Integer
    For i = 1 To Len(C1)
        ConvChs = Replace(ConvChs, Mid(C1, i, 1), Mid(C2, i, 1))
    Next
    ConvChs = Replace(ConvChs, " ", "")
    ConvChs = Replace(ConvChs, vbCrLf, "")
End Function'智能计算，去掉表达式中的中文内容
Private Function unChn(ByVal str1 As String) As String
    Dim i As Integer, t As String
    
    If Len(str1) = 0 Then Exit Function
    unChn = Replace(str1, vbCrLf, "+")
    For i = 1 To Len(unChn)
        t = Mid(unChn, i, 1)
        If Asc(t) < 0 Then
            unChn = Left(unChn, i - 1) & "+" & Mid(unChn, i + 1)
        End If
    Next
    
    i = InStr(unChn, "++")
    Do While i > 0
        unChn = Replace(unChn, "++", "+")
        i = InStr(unChn, "++")
    Loop
    If Left(unChn, 1) = "+" Then unChn = Mid(unChn, 2)
    If Right(unChn, 1) = "+" Then unChn = Left(unChn, Len(unChn) - 1)
  
End Function'检查表达式合法性
Function chkStr(ByVal c As String) As String
    Const allowNum = "0123456789."
    Const allowOp = "+-*/\()"
    
    Dim i As Integer, tmpStr As String, gL As Integer, gR As Integer
    
    '检查是否有非法运算符
    For i = 1 To Len(c)
        tmpStr = Mid(c, i, 1)
        
        If InStr(allowNum & allowOp, tmpStr) = 0 Then
            chkStr = "运算符 '" & tmpStr & "' 不可识别。"
            Exit For
        End If
        If tmpStr = "(" Then gL = gL + 1
        If tmpStr = ")" Then gR = gR + 1
    Next
    If gL > gR Then chkStr = "需要 ')' 。"
    If gL < gR Then chkStr = "需要 '(' 。"
    If chkStr <> "" Then Exit Function
    
    Dim tmpNext As String, l As Boolean
    '与下一个操作符组合是否合法
    For i = 1 To Len(c)
        tmpStr = Mid(c, i, 1)
        tmpNext = Mid(c, i + 1, 1)
        If InStr(allowNum, tmpStr) > 0 Then
            If tmpStr = "." Then    '小数点后只能是数字
                If InStr(allowOp, tmpNext) > 0 Or tmpNext = "." Or tmpNext = "" Then
                    l = True
                    Exit For
                End If
            Else        '数字后面只能是数字或操作符或 ')' 或 "."
                If InStr("+-*/\", tmpNext) = 0 And InStr(allowNum, tmpNext) = 0 And tmpNext <> ")" And tmpNext <> "." Then
                    l = True
                    Exit For
                End If
            End If
        End If
        
        If tmpStr = "(" Then    ' '(' 后只能是数字或 '-' 或 '('
            If InStr(allowNum, tmpNext) = 0 And tmpNext <> "-" And tmpNext <> "(" Or tmpNext = "" Then
                l = True
                Exit For
            End If
        End If
        
        If tmpStr = ")" Then    ' ')' 后只能是操作符或 ')'
            If InStr("+-*/\", tmpNext) = 0 And tmpNext <> ")" Then
                l = True
                Exit For
            End If
        End If
        
        If InStr("+-*/\", tmpStr) > 0 Then '操作符后只能是数字或 '('
            If InStr(allowNum, tmpNext) = 0 And tmpNext <> "(" Or tmpNext = "" Then
                l = True
                Exit For
            End If
        End If
    Next
    If l Then chkStr = "运算式有错误。"
End Function' string
' number
' date
' 取出一个字符
' 参数： Str1 处理的字符串
' 返回： 第一个字符
'        Str1 成为被取后的字符串
Private Function ReadChar(str1 As String) As String
    ReadChar = ""
    If str1 = "" Then Exit Function
    ReadChar = Left(str1, 1)
    str1 = Right(str1, Len(str1) - 1)
End Function' 退回一个字符
' 参数： Str1 处理的字符串
'        AChar 要退回的字符
' 返回： Str1 ：被退回的字符串
Private Function RetChar(str1 As String, AChar As String) As String
    str1 = AChar & str1
    RetChar = str1
End Function' 读入数字
' 参数： Str1 处理的字符串
' 返回：  取到的数字， "" 为错误！
'        Str1 ：处理后字符串
Private Function ReadNumber(str1 As String) As String
    Dim C1 As String, rets As String
    rets = ""
    C1 = ReadChar(str1)
    Do While C1 <> ""
        If (C1 >= "0" And C1 <= "9") Or C1 = "." Then
            rets = rets & C1
        Else
            RetChar str1, C1
            Exit Do
        End If
        C1 = ReadChar(str1)
    Loop
    ReadNumber = rets
End Function' 读入字符串
' 参数： Str1 处理的字符串
' 返回：  取到的字符串， "" 为错误！
'        Str1 ：处理后字符串
Private Function ReadString(str1 As String) As String
    Dim C1 As String, rets As String
    rets = ""
    C1 = ReadChar(str1)
    Do While C1 <> "" And C1 <> """"
        rets = rets & C1
        C1 = ReadChar(str1)
    Loop
    ReadString = rets
End Function' 读入操作符
' 参数： Str1 处理的字符串
' 返回：  取到的操作符， "" 为错误！
'        Str1 ：处理后字符串
Private Function ReadOp(str1 As String) As String
    Dim C1 As String, rets As String
    C1 = ReadChar(str1)
    ReadOp = ""
    Do While C1 <> ""
        If C1 <> " " Then
            If C1 = "*" Or C1 = "/" Or C1 = "\" Or C1 = "-" Or C1 = "+" Then
                ReadOp = C1
            Else
                RetChar str1, C1
            End If
            Exit Function
        End If
        C1 = ReadChar(str1)
    Loop
End Function' 取下一个
' Needed : String Number Any Op
Private Function GetValue(str1 As String) As String
    Dim C1 As String
    C1 = ReadChar(str1)
    Do While C1 = " " And C1 <> ""
        C1 = ReadChar(str1)
    Loop
    Select Case C1
        Case """"
            GetValue = ReadString(str1)
        Case "("
            GetValue = GetExp(str1)
            C1 = ReadChar(str1)
            Do While C1 <> "" And C1 = " "
                C1 = ReadChar(str1)
            Loop
            If C1 <> ")" Then ErrorStr = "需要 ')' 。"
        Case "0" To "9"
            GetValue = C1 & ReadNumber(str1)
        Case Else
            RetChar str1, C1
    End Select
End FunctionPrivate Function CompStr(Val1, Op, Val2) As String
    Dim NewVal
    Select Case Op
        Case "-"
            NewVal = Val(Val1) - Val(Val2)
        Case "+"
            NewVal = Val(Val1) + Val(Val2)
        Case "*"
            NewVal = Val(Val1) * Val(Val2)
        Case "/"
            If Val(Val2) <> 0 Then
                NewVal = Val(Val1) / Val(Val2)
            Else
                NewVal = 0
            End If
        Case "\"
            If Val(Val2) <> 0 Then
                NewVal = Val(Val1) \ Val(Val2)
            Else
                NewVal = 0
            End If
        Case Else
            NewVal = Val1
    End Select
    CompStr = NewVal
End Function

Answer 2

用法：?GetVal("12 * 2 - 5 * (3 / 4)")
20.25

Answer 3

第一种方法：Microsoft Script Control
第二种方法：
'函数描叙:把字符穿转化为表达式计算出值
'调用:computer(str)
'返回值:表达式的值
Private num As IntegerPrivate Function Computeadd(ByVal str As String) As String
    Dim i As Integer
    Dim n As Integer
    Dim s As String
    s = ""
    Computeadd = 0
    str = Trim(str)
    For i = 1 To Len(str)
        If Mid(str, i, 1) = "+" Or Mid(str, i, 1) = "-" Then
            If s = "" Then
                Computeadd = Val(Left(str, i - 1))
            End If
            If s = "+" Then
                Computeadd = Round(Computeadd + Val(Mid(str, n + 1, i - n - 1)), num)
            End If
            If s = "-" Then
                Computeadd = Round(Computeadd - Val(Mid(str, n + 1, i - n - 1)), num)
            End If
            s = Mid(str, i, 1)
            n = i
        End If
        If i = Len(str) Then
            If s = "+" Then
                Computeadd = Round(Computeadd + Val(Right(str, Len(str) - n)), num)
            End If
            If s = "-" Then
                Computeadd = Round(Computeadd - Val(Right(str, Len(str) - n)), num)
            End If
            If s = "" Then
                Computeadd = str
            End If
        End If
    Next i
End FunctionPrivate Function computech(ByVal str As String) As String    Dim s As String
    Dim sl As Double
    Dim i As Integer
    Dim n As Integer
    str = Trim(str)
    computech = ""
    s = ""
    n = 0
    For i = 1 To Len(str)
        If Mid(str, i, 1) = "+" Or Mid(str, i, 1) = "-" Then     '检测到加号与减号
            If s = "" Then                                         's为空
                computech = Left(str, i)
            End If
            If s = "*" Then                                          's为乘
                computech = computech + Trim(Round(sl * Val(Mid(str, n + 1, i - n - 1)), num)) + Mid(str, i, 1)
            End If
            If s = "/" Then                                            's为除
                computech = computech + Trim(Round(sl / Val(Mid(str, n + 1, i - n - 1)), num)) + Mid(str, i, 1)
            End If
            If s = "+" Or s = "-" Then                                    's为加与减
                computech = computech + Mid(str, n + 1, i - n)
            End If
            s = Mid(str, i, 1)
            n = i
        End If
        If Mid(str, i, 1) = "*" Or Mid(str, i, 1) = "/" Then     '检测到乘号与除号
            If s = "*" Then                                           's为乘
                sl = Round(sl * Val(Mid(str, n + 1, i - n - 1)), num)
            End If
            If s = "/" Then
                sl = Round(sl / Val(Mid(str, n + 1, i - n - 1)), num)                's为除
            End If
            If s = "+" Or s = "-" Then                               's为加与减
                sl = Round(Val(Mid(str, n + 1, i - n - 1)), num)
            End If
            If s = "" Then
                sl = Round(Val(Left(str, i - 1)), num)
            End If            s = Mid(str, i, 1)
            n = i
        End If
        If i = Len(str) Then                                  '到文件结尾
            If s = "+" Or s = "-" Then
                computech = computech + Right(str, i - n)
            End If
            If s = "*" Then
                computech = computech + Trim(Round(sl * Val(Right(str, i - n)), num))
            End If
            If s = "/" Then
                computech = computech + Trim(Round(sl / Val(Right(str, i - n)), num))
            End If
            If s = "" Then
                computech = str
            End If
        End If
    Next i
End FunctionPrivate Function fun(ByVal funname As String, ByVal str As String) As String '其它标准函数计算
    If funname = "sum" Then fun = Trim(computer(str))
End FunctionPrivate Function computefu1(ByVal str As String) As String       '处理标准函数
    Dim i As Integer
    Dim s As String
    Dim n As Integer
    Dim m As String
    str = Trim(str)
    For i = 1 To Len(str)
        If Mid(str, i, 1) <> "0" And Mid(str, i, 1) <> "." And Mid(str, i, 1) <> "1" And Mid(str, i, 1) <> "2" And Mid(str, i, 1) <> "3" And Mid(str, i, 1) <> "4" And Mid(str, i, 1) <> "5" And Mid(str, i, 1) <> "6" And Mid(str, i, 1) <> "7" And Mid(str, i, 1) <> "8" And Mid(str, i, 1) <> "9" And Mid(str, i, 1) <> "" And Mid(str, i, 1) <> "+" And Mid(str, i, 1) <> "-" And Mid(str, i, 1) <> "/" And Mid(str, i, 1) <> "*" Then
            s = Mid(str, i, 3)
            For n = i + 4 To Len(str)
                If Mid(str, n, 1) <> "+" And Mid(str, n, 1) <> "/" And Mid(str, n, 1) <> "*" And Mid(str, n, 1) <> "-" And Mid(str, n, 1) <> "(" Then
                    If m = "yes" Then computefu1 = computefu1 + "*"
                    computefu1 = computefu1 + fun(s, Mid(str, i + 4, n - i - 4))
                    i = n
                    m = "yes"
                    Exit For
                End If
            Next n
        Else
            computefu1 = computefu1 + Mid(str, i, 1)
            If Trim(Mid(str, i, 1)) <> "+" And Trim(Mid(str, i, 1)) <> "-" And Mid(str, i, 1) <> "*" And Mid(str, i, 1) <> "/" And Mid(str, i, 1) <> "(" Then
                m = "yes"
            Else
                m = "no"
            End If
        End If
    Next i
End FunctionPrivate Function compute1(ByVal str As String) As String
    compute1 = Trim(Computeadd(computech(computefuhua(computefu1(str)))))
End Function

Answer 4

Private Function computefuhua(ByVal str As String) As String     '处理符号靠在一起的问题
    Dim i As Integer
    Dim n As Integer
    Dim s As String
    s = ""
    computefuhua = ""
    str = Trim(str)
    For i = Len(str) To 1 Step -1
        If computefuhua = "" Then                    '第一个字符
            computefuhua = Mid(str, i, 1)
        Else
            If Left(computefuhua, 1) = "+" Or Left(computefuhua, 1) = "-" Or s = "-" Then     '之前无遗留
                If Left(computefuhua, 1) = "+" Then                  '之前有检测到"+"
                    Select Case Mid(str, i, 1)
                        Case "-"
                            computefuhua = "-" + Right(computefuhua, Len(computefuhua) - 1)
                            s = ""
                        Case "+"
                            computefuhua = "+" + Right(computefuhua, Len(computefuhua) - 1)
                            s = ""
                        Case "*"
                            computefuhua = "*" + Right(computefuhua, Len(computefuhua) - 1)
                        Case "/"
                            computefuhua = "/" + Right(computefuhua, Len(computefuhua) - 1)
                    End Select
                    If Mid(str, i, 1) <> "+" And Mid(str, i, 1) <> "-" And Mid(str, i, 1) <> "*" And Mid(str, i, 1) <> "/" Then
                        computefuhua = Mid(str, i, 1) + computefuhua
                    End If
                Else
                    If Left(computefuhua, 1) = "-" Or s = "-" Then       '之前有测到"-"
                        If Left(computefuhua, 1) = "-" Then                  '左"-"
                            Select Case Mid(str, i, 1)
                                Case "-"
                                    computefuhua = "+" + Right(computefuhua, Len(computefuhua) - 1)
                                    s = ""
                                Case "+"
                                    computefuhua = "-" + Right(computefuhua, Len(computefuhua) - 1)
                                    s = ""
                                Case "*"
                                    computefuhua = "*" + Right(computefuhua, Len(computefuhua) - 1)
                                    s = "-"
                                Case "/"
                                    computefuhua = "/" + Right(computefuhua, Len(computefuhua) - 1)
                                    s = "-"
                            End Select
                            If Mid(str, i, 1) <> "+" And Mid(str, i, 1) <> "-" And Mid(str, i, 1) <> "*" And Mid(str, i, 1) <> "/" Then
                                computefuhua = Mid(str, i, 1) + computefuhua
                            End If
                            's"-"
                        Else
                            Select Case Mid(str, i, 1)
                                Case "-"
                                    computefuhua = "+" + computefuhua
                                    s = ""
                                Case "+"
                                    computefuhua = "-" + computefuhua
                                    s = ""
                                Case "*"
                                    computefuhua = "*" + computefuhua
                                    s = "-"
                                Case "/"
                                    computefuhua = "/" + computefuhua
                                    s = "-"
                            End Select
                            If Mid(str, i, 1) <> "+" And Mid(str, i, 1) <> "-" And Mid(str, i, 1) <> "*" And Mid(str, i, 1) <> "/" Then
                                computefuhua = Mid(str, i, 1) + computefuhua
                            End If
                        End If
                    End If
                End If
            Else
                computefuhua = Mid(str, i, 1) + computefuhua
            End If
        End If
    Next i
    If Left(computefuhua, 1) = "+" Then
        computefuhua = Right(computefuhua, Len(computefuhua) - 1)
    End If
End Function

Answer 5

'-----------------------------------------------------------------------------------
Public Function computer(ByVal str As String) As String        '综合运算
 num = 12
    Dim i As Integer
    Dim n As Integer
    str = Trim(str)
    '去除前后的空格     ok   ok   ok
    For i = 1 To Len(str)
        If Mid(str, i, 1) <> "" Then
            computer = computer + Mid(str, i, 1)
        End If
    Next i
    str = Trim(computer)
    computer = ""
    '检测到函数后没有括号的加括号
    For i = 1 To Len(str)
        If Mid(str, i, 1) <> "(" And Mid(str, i, 1) <> ")" And Mid(str, i, 1) <> "0" And Mid(str, i, 1) <> "." And Mid(str, i, 1) <> "1" And Mid(str, i, 1) <> "2" And Mid(str, i, 1) <> "3" And Mid(str, i, 1) <> "4" And Mid(str, i, 1) <> "5" And Mid(str, i, 1) <> "6" And Mid(str, i, 1) <> "7" And Mid(str, i, 1) <> "8" And Mid(str, i, 1) <> "9" And Mid(str, i, 1) <> "" And Mid(str, i, 1) <> "+" And Mid(str, i, 1) <> "-" And Mid(str, i, 1) <> "/" And Mid(str, i, 1) <> "*" Then
            If Mid(str, i + 3, 1) <> "(" Then
                For n = i + 3 To Len(str)
                    If Val(Mid(str, n, 1)) = 0 And Mid(str, n, 1) <> "0" And Mid(str, n, 1) <> "." Then
                        computer = computer + Mid(str, i, 3) + "(" + Mid(str, i + 3, n - i - 3) + ")"
                        i = n - 1
                        Exit For
                    End If
                    If n = Len(str) Then
                        computer = computer + Mid(str, i, 3) + "(" + Right(str, Len(str) - i - 2) + ")"
                        i = Len(str)
                    End If
                Next n
            Else
                computer = computer + Mid(str, i, 3)
                i = i + 2
            End If
        Else
            computer = computer + Mid(str, i, 1)
        End If
    Next i
    str = computer
    computer = ""
    '给省了乘号的加乘号
    For i = 1 To Len(str)
        computer = computer + Mid(str, i, 1)
        If i < Len(str) Then
            If Mid(str, i, 1) = ")" Then
                If Mid(str, i + 1, 1) <> ")" And Mid(str, i + 1, 1) <> "+" And Mid(str, i + 1, 1) <> "-" And Mid(str, i + 1, 1) <> "*" And Mid(str, i + 1, 1) <> "/" Then
                    computer = computer + "*"
                End If
            End If
        End If
    Next i
    str = computer
    computer = ""
    For i = 1 To Len(str)
        If Mid(str, i, 1) = "(" And i <> 1 Then
            If Mid(str, i - 1, 1) = "0" Or Mid(str, i - 1, 1) = ")" Or Val(Mid(str, i - 1, 1)) > 0 Then
                computer = computer + "*"
            End If
        End If
        computer = computer + Mid(str, i, 1)
    Next i
    str = computer
    computer = ""
    '综合运算
    For i = 1 To Len(str)
        computer = computer + Mid(str, i, 1)
        If Right(computer, 1) = ")" Then
            For n = Len(computer) To 1 Step -1
                If Mid(computer, n, 1) = "(" Then
                    If n = 1 Then
                        computer = compute1(Mid(computer, n + 1, Len(computer) - n - 1))
                    Else
                        If Mid(computer, n - 1, 1) <> "0" And Mid(computer, n - 1, 1) <> "1" And Mid(computer, n - 1, 1) <> "2" And Mid(computer, n - 1, 1) <> "3" And Mid(computer, n - 1, 1) <> "4" And Mid(computer, n - 1, 1) <> "5" And Mid(computer, n - 1, 1) <> "6" And Mid(computer, n - 1, 1) <> "7" And Mid(computer, n - 1, 1) <> "8" And Mid(computer, n - 1, 1) <> "9" And Mid(computer, n - 1, 1) <> "(" And Mid(computer, n - 1, 1) <> ")" And Mid(computer, n - 1, 1) <> "." And Mid(computer, n - 1, 1) <> "-" And Mid(computer, n - 1, 1) <> "/" And Mid(computer, n - 1, 1) <> "*" And Mid(computer, n - 1, 1) <> "+" Then
                            computer = Left(computer, n - 4) + fun(Mid(computer, n - 3, 3), compute1(Mid(computer, n + 1, Len(computer) - n - 1)))
                        Else
                            computer = Left(computer, n - 1) + compute1(Mid(computer, n + 1, Len(computer) - n - 1))
                        End If
                    End If
                    Exit For
                End If
            Next n
        End If
    Next i
    computer = compute1(computer)
End Function