关于表达式计算的:

Question

编写一个程序，其功能是：从键盘输入一个表达式字符串，其中包括数值子字符串以及＋（加）、－（减）、*（乘）、/（除）四个运算符号与左右括号“(、)”；然后计算并输出该表达式的值。假设输入的表达式字符串总长度不超过60，且其中所包括的运算都是合法的（即在程序中不考虑不合法的运算）。例如，输入的表达式字符串为
    1.5*(2.5＋3.5)－(5.5－1)/3
输出结果为
    1.5*(2.5＋3.5)－(5.5－1)/3＝7.5（计算结果）
    要求结果的输出格式为
    表达式字符串＝计算结果 需要代码.帮朋友要的

Answer 1

Private Sub Command1_Click()
    Dim test As String
    test = "1.5*(2.5+3.5)-(5.5-1)/3"
    Set scr = CreateObject("MSScriptControl.ScriptControl")
    scr.Language = "vbscript"
    MsgBox test & "=" & scr.Eval(test)
End Sub

Answer 2

另一种方法更简单，用WebBrowser控件WebBrowser1.Navigate "javascript:" & "1.5*(2.5+3.5)-(5.5-1)/3"msgbox WebBrowser1.Document.body.innerHTML

Answer 3

Private Declare Function EbExecuteLine Lib "vba6.dll" (ByVal pStringToExec As Long, ByVal Unknownn1 As Long, ByVal Unknownn2 As Long, ByVal fCheckOnly As Long) As Long '  APIPrivate Function ExecuteLine(sCode As String, Optional fCheckOnly As Boolean) As Boolean
ExecuteLine = EbExecuteLine(StrPtr(sCode), 0&, 0&, Abs(fCheckOnly)) = 0
End Function
Private Function result(ByVal x As String) As Single '计算表达式的结果
ExecuteLine "dim x as single"
ExecuteLine "x= " & x
ExecuteLine "clipboard.settext x" '发送到剪切板
result = Clipboard.GetText '从剪切板获取
Clipboard.Clear '清空剪切板
End FunctionPrivate Sub Command1_Click()
    Dim test As String
    test = "1.5*(2.5+3.5)-(5.5-1)/3"
    MsgBox test & "=" & result(test)
End Sub

Answer 4

'在工程中添加“Microsoft Script Control1.0”控件，然后试试下面的代码Private Sub Command1_Click()
    MsgBox Me.ScriptControl1.Eval("1.5*(2.5+3.5)-(5.5-1)/3")
End Sub

Answer 5

前面不是有这样的贴子吗？
Private Function EvaluateExpr(ByVal expr As String) As Single
    Const PREC_NONE = 11
    Const PREC_UNARY = 10
    Const PREC_POWER = 9
    Const PREC_TIMES = 8
    Const PREC_DIV = 7
    Const PREC_INT_DIV = 6
    Const PREC_MOD = 5
    Const PREC_PLUS = 4    Dim is_unary As Boolean
    Dim next_unary As Boolean
    Dim parens As Integer
    Dim pos As Integer
    Dim expr_len As Integer
    Dim ch As String
    Dim lexpr As String
    Dim rexpr As String
    Dim value As String
    Dim status As Long
    Dim best_pos As Integer
    Dim best_prec As Integer    ' Remove leading and trailing blanks.
    expr = Trim$(expr)
    expr_len = Len(expr)
    If expr_len = 0 Then Exit Function    ' If we find + or - now, it is a unary operator.
    is_unary = True    ' So far we have nothing.
    best_prec = PREC_NONE    ' Find the operator with the lowest precedence.
    ' Look for places where there are no open
    ' parentheses.
    For pos = 1 To expr_len
        ' Examine the next character.
        ch = Mid$(expr, pos, 1)        ' Assume we will not find an operator. In
        ' that case the next operator will not
        ' be unary.
        next_unary = False        If ch = " " Then
            ' Just skip spaces.
            next_unary = is_unary
        ElseIf ch = "(" Then
            ' Increase the open parentheses count.
            parens = parens + 1            ' An operator after "(" is unary.
            next_unary = True
        ElseIf ch = ")" Then
            ' Decrease the open parentheses count.
            parens = parens - 1            ' An operator after ")" is not unary.
            next_unary = False            ' If parens < 0, too many ')'s.
            If parens < 0 Then
                Err.Raise vbObjectError + 1001, _
                    "EvaluateExpr", _
                    "Too many )s in '" & _
                    expr & "'"
            End If
        ElseIf parens = 0 Then
            ' See if this is an operator.
            If ch = "^" Or ch = "*" Or _
               ch = "/" Or ch = "\" Or _
               ch = "%" Or ch = "+" Or _
               ch = "-" _
            Then
                ' An operator after an operator
                ' is unary.
                next_unary = True
                
                Select Case ch
                    Case "^"
                        If best_prec >= PREC_POWER Then
                            best_prec = PREC_POWER
                            best_pos = pos
                        End If
                    
                    Case "*", "/"
                        If best_prec >= PREC_TIMES Then
                            best_prec = PREC_TIMES
                            best_pos = pos
                        End If
                    
                    Case "\"
                        If best_prec >= PREC_INT_DIV Then
                            best_prec = PREC_INT_DIV
                            best_pos = pos
                        End If
                    
                    Case "%"
                        If best_prec >= PREC_MOD Then
                            best_prec = PREC_MOD
                            best_pos = pos
                        End If
                    
                    Case "+", "-"
                        ' Ignore unary operators
                        ' for now.
                        If (Not is_unary) And _
                            best_prec >= PREC_PLUS _
                        Then
                            best_prec = PREC_PLUS
                            best_pos = pos
                        End If
                End Select
            End If
        End If
        is_unary = next_unary
    Next pos
    
    ' If the parentheses count is not zero,
    ' there's a ')' missing.
    If parens <> 0 Then
        Err.Raise vbObjectError + 1002, _
            "EvaluateExpr", "Missing ) in '" & _
            expr & "'"
    End If
    
    ' Hopefully we have the operator.
    If best_prec < PREC_NONE Then
        lexpr = Left$(expr, best_pos - 1)
        rexpr = Right$(expr, expr_len - best_pos)
        Select Case Mid$(expr, best_pos, 1)
            Case "^"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) ^ _
                    EvaluateExpr(rexpr)
            Case "*"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) * _
                    EvaluateExpr(rexpr)
            Case "/"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) / _
                    EvaluateExpr(rexpr)
            Case "\"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) \ _
                    EvaluateExpr(rexpr)
            Case "%"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) Mod _
                    EvaluateExpr(rexpr)
            Case "+"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) + _
                    EvaluateExpr(rexpr)
            Case "-"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) - _
                    EvaluateExpr(rexpr)
        End Select
        Exit Function
    End If
    
    ' If we do not yet have an operator, there
    ' are several possibilities:
    '
    ' 1. expr is (expr2) for some expr2.
    ' 2. expr is -expr2 or +expr2 for some expr2.
    ' 3. expr is Fun(expr2) for a function Fun.
    ' 4. expr is a primitive.
    ' 5. It's a literal like "3.14159".
    
    ' Look for (expr2).
    If Left$(expr, 1) = "(" And Right$(expr, 1) = ")" Then
        ' Remove the parentheses.
        EvaluateExpr = EvaluateExpr(Mid$(expr, 2, expr_len - 2))
        Exit Function
    End If
        
    ' Look for -expr2.
    If Left$(expr, 1) = "-" Then
        EvaluateExpr = -EvaluateExpr( _
            Right$(expr, expr_len - 1))
        Exit Function
    End If
    
    ' Look for +expr2.
    If Left$(expr, 1) = "+" Then
        EvaluateExpr = EvaluateExpr( _
            Right$(expr, expr_len - 1))
        Exit Function
    End If
    
    ' Look for Fun(expr2).
    If expr_len > 5 And Right$(expr, 1) = ")" Then
        lexpr = LCase$(Left$(expr, 4))
        rexpr = Mid$(expr, 5, expr_len - 5)
        Select Case lexpr
            Case "sin("
                EvaluateExpr = Sin(EvaluateExpr(rexpr))
                Exit Function
            Case "cos("
                EvaluateExpr = Cos(EvaluateExpr(rexpr))
                Exit Function
            Case "tan("
                EvaluateExpr = Tan(EvaluateExpr(rexpr))
                Exit Function
            Case "sqr("
                EvaluateExpr = Sqr(EvaluateExpr(rexpr))
                Exit Function
        End Select
    End If
    
    On Error Resume Next
    EvaluateExpr = CSng(expr)
    status = Err.Number
    On Error GoTo 0
    If status <> 0 Then
        Err.Raise status, _
            "EvaluateExpr", _
            "Error evaluating '" & expr & _
            "' as a constant."
    End If
End Function
Private Sub Command1_Click()
Print EvaluateExpr(Text1.Text)
End Sub

Answer 6

再给你一个已用在商业软件中的代码Private Function EvaluateExpr(ByVal expr As String) As Single
'--------------------------------------------------------------------------
'功能:
'       字符串表达式的计算
'参数:
'       [expr]...........................字符串表达式
'返回值:
'       [EvaluateExpr]...................计算后的值
'--------------------------------------------------------------------------
Const PREC_NONE = 11
Const PREC_UNARY = 10   ' Not actually used.
Const PREC_POWER = 9
Const PREC_TIMES = 8
Const PREC_DIV = 7
Const PREC_INT_DIV = 6
Const PREC_MOD = 5
Const PREC_PLUS = 4Dim is_unary As Boolean
Dim next_unary As Boolean
Dim parens As Integer
Dim pos As Integer
Dim expr_len As Integer
Dim ch As String
Dim lexpr As String
Dim rexpr As String
Dim Value As String
Dim status As Long
Dim best_pos As Integer
Dim best_prec As Integer    ' 删除首尾空格及有效性校验
    expr = Trim$(expr)
    expr_len = Len(expr)
    If expr_len = 0 Then Exit Function
    
    ' If we find + or - now, it is a unary operator.
    is_unary = True
    
    ' So far we have nothing.
    best_prec = PREC_NONE
    
    ' Find the operator with the lowest precedence.
    ' Look for places where there are no open
    ' parentheses.
    For pos = 1 To expr_len
        ' Examine the next character.(检查下一个字符)
        ch = Mid$(expr, pos, 1)        ' Assume we will not find an operator. In
        ' that case the next operator will not
        ' be unary.
        next_unary = False
        
        If ch = " " Then
            ' Just skip spaces.
            next_unary = is_unary
        ElseIf ch = "(" Then
            ' Increase the open parentheses count.
            parens = parens + 1            ' An operator after "(" is unary.
            next_unary = True
        ElseIf ch = ")" Then
            ' Decrease the open parentheses count.
            parens = parens - 1            ' An operator after ")" is not unary.
            next_unary = False            ' If parens < 0, too many ')'s.
            If parens < 0 Then
                Err.Raise vbObjectError + 1001, _
                    "EvaluateExpr", _
                    "Too many )s in '" & _
                    expr & "'"
            End If
        ElseIf parens = 0 Then
            ' See if this is an operator.
            If ch = "^" Or ch = "*" Or _
               ch = "/" Or ch = "\" Or _
               ch = "%" Or ch = "+" Or _
               ch = "-" _
            Then
                ' An operator after an operator
                ' is unary.
                next_unary = True
                
                Select Case ch
                    Case "^"
                        If best_prec >= PREC_POWER Then
                            best_prec = PREC_POWER
                            best_pos = pos
                        End If
                    Case "*", "/"
                        If best_prec >= PREC_TIMES Then
                            best_prec = PREC_TIMES
                            best_pos = pos
                        End If
                    
                    Case "\"
                        If best_prec >= PREC_INT_DIV Then
                            best_prec = PREC_INT_DIV
                            best_pos = pos
                        End If
                    
                    Case "%"
                        If best_prec >= PREC_MOD Then
                            best_prec = PREC_MOD
                            best_pos = pos
                        End If
                    
                    Case "+", "-"
                        ' Ignore unary operators
                        ' for now.
                        If (Not is_unary) And _
                            best_prec >= PREC_PLUS _
                        Then
                            best_prec = PREC_PLUS
                            best_pos = pos
                        End If
                End Select
            End If
        End If
        is_unary = next_unary
    Next pos
    
    ' If the parentheses count is not zero,
    ' there's a ')' missing.
    If parens <> 0 Then
        Err.Raise vbObjectError + 1002, _
            "EvaluateExpr", "Missing ) in '" & _
            expr & "'"
    End If
    
    ' Hopefully we have the operator.
    ' best_prec是最高的运算符
    Dim dblTemp1 As Double, dblTemp2 As Double
    If best_prec < PREC_NONE Then
        lexpr = Left$(expr, best_pos - 1)
        rexpr = Right$(expr, expr_len - best_pos)
        Select Case Mid$(expr, best_pos, 1)
            Case "^"
                EvaluateExpr = EvaluateExpr(lexpr) ^ EvaluateExpr(rexpr)
            Case "*"
                EvaluateExpr = EvaluateExpr(lexpr) * EvaluateExpr(rexpr)
            Case "/"
                dblTemp1 = EvaluateExpr(rexpr)
                dblTemp2 = EvaluateExpr(lexpr)
                If dblTemp1 = 0 Then
                    EvaluateExpr = 0
                Else
                    EvaluateExpr = dblTemp2 / dblTemp1
                End If
            Case "\"
                EvaluateExpr = EvaluateExpr(lexpr) \ EvaluateExpr(rexpr)
            Case "%"
                EvaluateExpr = EvaluateExpr(lexpr) Mod EvaluateExpr(rexpr)
            Case "+"
                EvaluateExpr = EvaluateExpr(lexpr) + EvaluateExpr(rexpr)
            Case "-"
                EvaluateExpr = EvaluateExpr(lexpr) - EvaluateExpr(rexpr)
        End Select
        Exit Function
    End If
    
    ' If we do not yet have an operator, there
    ' are several possibilities:
    '
    ' 1. expr is (expr2) for some expr2.
    ' 2. expr is -expr2 or +expr2 for some expr2.
    ' 3. expr is Fun(expr2) for a function Fun.
    ' 4. expr is a primitive.
    ' 5. It's a literal like "3.14159".
    
    ' Look for (expr2).
    If Left$(expr, 1) = "(" And Right$(expr, 1) = ")" Then
        ' Remove the parentheses.
        EvaluateExpr = EvaluateExpr(Mid$(expr, 2, expr_len - 2))
        Exit Function
    End If
        
    ' Look for -expr2.
    If Left$(expr, 1) = "-" Then
        EvaluateExpr = -EvaluateExpr( _
            Right$(expr, expr_len - 1))
        Exit Function
    End If
    
    ' Look for +expr2.
    If Left$(expr, 1) = "+" Then
        EvaluateExpr = EvaluateExpr( _
            Right$(expr, expr_len - 1))
        Exit Function
    End If
    
    ' Look for Fun(expr2).
    If expr_len > 5 And Right$(expr, 1) = ")" Then
        lexpr = LCase$(Left$(expr, 4))
        rexpr = Mid$(expr, 5, expr_len - 5)
        Select Case lexpr
            Case "sin("
                EvaluateExpr = Sin(EvaluateExpr(rexpr))
                Exit Function
            Case "cos("
                EvaluateExpr = Cos(EvaluateExpr(rexpr))
                Exit Function
            Case "tan("
                EvaluateExpr = Tan(EvaluateExpr(rexpr))
                Exit Function
            Case "sqr("
                EvaluateExpr = Sqr(EvaluateExpr(rexpr))
                Exit Function
        End Select
    End If
    
    ' See if it's a primitive.
    On Error Resume Next
    Value = Primitives.Item(expr)
    status = Err.Number
    On Error GoTo 0
    If status = 0 Then
        EvaluateExpr = CSng(Value)
        Exit Function
    End If
    
    ' It must be a literal like "2.71828".
    On Error Resume Next
    EvaluateExpr = CSng(expr)
    status = Err.Number
    On Error GoTo 0
    If status <> 0 Then
        Err.Raise status, _
            "EvaluateExpr", _
            "Error evaluating '" & expr & _
            "' as a constant."
    End If
End Function

Answer 7

Private Sub Command1_Click()
Dim str As String
str = " 1.5 * (2.5 + 3.5) - (5.5 - 1) / 3"
Dim scr As Object
Set scr = CreateObject("MSScriptControl.ScriptControl")
  scr.Language = "vbscript"
Text1.Text = scr.Eval(str)
End Sub