请高手相助修改一个能进行逻辑运算的程序，谢谢！！！

Question

请把下面的代码写入一文本文件，保存为ExpressionForm.FRM即可，谢谢！！！Option Explicit
Dim Primitives As CollectionPrivate Function EvaluateExpr(ByVal Expr As String) As StringConst PREC_NONE = 11Const PREC_UNARY = 10 ' Not actually used.Const PREC_POWER = 9Const PREC_TIMES = 8Const PREC_DIV = 7Const PREC_INT_DIV = 6Const PREC_MOD = 5Const PREC_PLUS = 4
Dim is_unary As BooleanDim next_unary As BooleanDim parens As IntegerDim pos As IntegerDim expr_len As IntegerDim ch As StringDim lexpr As StringDim rexpr As StringDim value As StringDim status As LongDim best_pos As IntegerDim best_prec As IntegerDim v As Variant' 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_unaryElseIf ch = "(" Then' Increase the open parentheses count.parens = parens + 1
' An operator after "(" is unary.next_unary = TrueElseIf ch = ")" Then
parens = parens - 1
next_unary = True
If parens < 0 ThenErr.Raise vbObjectError + 1001, "EvaluateExpr", "Too many )s in '" & Expr & "'"End IfElseIf 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 chCase "^"If best_prec >= PREC_POWER Thenbest_prec = PREC_POWERbest_pos = posEnd If
Case "*", "/"If best_prec >= PREC_TIMES Thenbest_prec = PREC_TIMESbest_pos = posEnd If
Case "\"If best_prec >= PREC_INT_DIV Thenbest_prec = PREC_INT_DIVbest_pos = posEnd If
Case "%"If best_prec >= PREC_MOD Thenbest_prec = PREC_MODbest_pos = posEnd If
Case "+", "-"' Ignore unary operators' for now.If (Not is_unary) And best_prec >= PREC_PLUS Thenbest_prec = PREC_PLUSbest_pos = posEnd IfEnd SelectEnd IfEnd Ifis_unary = next_unaryNext pos
' If the parentheses count is not zero,' there's a ')' missing.If parens <> 0 ThenErr.Raise vbObjectError + 1002, "EvaluateExpr", "Missing ) in '" & Expr & "'"End If
' Hopefully we have the operator.If best_prec < PREC_NONE Thenlexpr = 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 = Val(EvaluateExpr(lexpr)) + Val(EvaluateExpr(rexpr)) 'Çó½Ìµ±nµÄֵΪ¿Õֵʱ,½â¾öÀàÐÍ´íÎóµÄÎÊÌ⣬ллCase "-"EvaluateExpr = EvaluateExpr(lexpr) - EvaluateExpr(rexpr)End SelectExit FunctionEnd IfIf Left$(Expr, 1) = "(" And Right$(Expr, 1) = ")" Then' Remove the parentheses.EvaluateExpr = EvaluateExpr(Mid$(Expr, 2, expr_len - 2))Exit FunctionEnd If
' Look for -expr2.If Left$(Expr, 1) = "-" ThenEvaluateExpr = -EvaluateExpr(Right$(Expr, expr_len - 1))Exit FunctionEnd If
' Look for +expr2.If Left$(Expr, 1) = "+" ThenEvaluateExpr = EvaluateExpr(Right$(Expr, expr_len - 1))Exit FunctionEnd If
' Look for Fun(expr2).If expr_len > 5 And Right$(Expr, 1) = ")" Thenlexpr = LCase$(Left$(Expr, 4))rexpr = Mid$(Expr, 5, expr_len - 5)Select Case lexprCase "sin("EvaluateExpr = Sin(EvaluateExpr(rexpr))Exit FunctionCase "cos("EvaluateExpr = Cos(EvaluateExpr(rexpr))Exit FunctionCase "tan("EvaluateExpr = Tan(EvaluateExpr(rexpr))Exit FunctionCase "sqr("EvaluateExpr = Sqr(EvaluateExpr(rexpr))Exit FunctionCase "sum("v = SplitParams(rexpr)
EvaluateExpr = sum(EvaluateExpr(v(0)), EvaluateExpr(v(1)))Exit FunctionEnd SelectEnd If
' See if it's a primitive.On Error Resume Nextvalue = Primitives.Item(Expr)
status = Err.Number
On Error GoTo 0If status = 0 Then
If value = "" Then
EvaluateExpr = 0
Exit Function
End IfEvaluateExpr = CSng(value)Exit FunctionEnd If
' It must be a literal like "2.71828".On Error Resume NextEvaluateExpr = CSng(Expr)status = Err.NumberOn Error GoTo 0If status <> 0 ThenErr.Raise status, "EvaluateExpr", "Error evaluating '" & Expr & "' as a constant."End IfEnd Function' ************************************************' Evaluate the expression entered by the user.' ************************************************Private Sub CmdEvaluate_Click()Dim i As IntegerDim name As StringDim value As StringDim Expr As StringDim rslt As SingleDim pos As Integer
' Store the primitives.Set Primitives = New CollectionFor i = 0 To 4name = Trim$(NameText(i).Text)value = Trim$(ValueText(i).Text)If name <> "" ThenPrimitives.Add value, nameEnd IfNext i
' Get the expression.Expr = ExprText.Text
' Evaluate the expression.ResultLabel.Caption = ""On Error GoTo EvaluateErrorrslt = EvaluateExpr(Expr)ResultLabel.Caption = Format$(rslt)Exit Sub
EvaluateError:BeepMsgBox Err.DescriptionEnd SubPrivate Function SplitParams(ByVal Expr As String) As String()
    Dim a() As String
    Dim lCount As Long
    Dim ch As String
    Dim lParanCount As Long
    Dim iStart As Long
    Dim i As Long
                           
    iStart = 1
    For i = 1 To Len(Expr)
        ch = Mid$(Expr, i, 1)
        Select Case ch
            Case "("
                lParanCount = lParanCount + 1
            Case ")"
                lParanCount = lParanCount - 1
            Case ","
                If lParanCount = 0 Then
                    lCount = lCount + 1
                    ReDim Preserve a(lCount - 1)
                    a(lCount - 1) = Mid$(Expr, iStart, i - iStart)
                    iStart = i + 1
                End If
        End Select
    Next
    If i > iStart Then
        lCount = lCount + 1
        ReDim Preserve a(lCount - 1)
        a(lCount - 1) = Mid$(Expr, iStart, i - iStart)
        iStart = i + 1
    End If
    
    SplitParams = a
End Function
Private Function sum(x As String, n As Integer) As String sum = Val(x) + n
End Function

Answer 1

这个不熟,我一般是用micosoft script control来计算这种表达式的

Answer 2

不好意思，内容贴错了。我想进行一个逻辑运算。如在下面的代码中：
sum(3+n)和SUM(3+IF(N>M,N,M),D)能运算 SUM(3+IF(N>M AND N>F,N,M),D)不能运算，求教能使SUM(3+IF(N>M AND N>F,N,M),D)正确运算方法，谢谢！！！
请把下面的代码写入一文本文件，保存为ExpressionForm.FRM即可，谢谢！！！ 
VERSION 5.00
Begin VB.Form ExpressionForm 
   Caption         =   "Expression"
   ClientHeight    =   5640
   ClientLeft      =   1380
   ClientTop       =   2100
   ClientWidth     =   8205
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5640
   ScaleWidth      =   8205
   Begin VB.TextBox ExprText 
      Height          =   285
      Left            =   0
      TabIndex        =   0
      Text            =   "SUM(3+IF(N>M AND N>F,N,M),D)"
      Top             =   480
      Width           =   3615
   End
   Begin VB.CommandButton CmdEvaluate 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Evaluate"
      Default         =   -1  'True
      Height          =   495
      Left            =   240
      TabIndex        =   11
      Top             =   3360
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Appearance      =   0  'Flat
      Caption         =   "Primitives"
      ForeColor       =   &H80000008&
      Height          =   4935
      Left            =   3720
      TabIndex        =   12
      Top             =   0
      Width           =   2895
      Begin VB.TextBox NameText 
         Height          =   285
         Index           =   0
         Left            =   240
         TabIndex        =   1
         Text            =   "n"
         Top             =   480
         Width           =   1215
      End
      Begin VB.TextBox ValueText 
         Height          =   285
         Index           =   0
         Left            =   1560
         TabIndex        =   2
         Text            =   "6"
         Top             =   480
         Width           =   1215
      End
      Begin VB.TextBox NameText 
         Height          =   285
         Index           =   1
         Left            =   240
         TabIndex        =   3
         Text            =   "M"
         Top             =   840
         Width           =   1215
      End
      Begin VB.TextBox ValueText 
         Height          =   285
         Index           =   1
         Left            =   1560
         TabIndex        =   4
         Text            =   "9"
         Top             =   840
         Width           =   1215
      End
      Begin VB.TextBox NameText 
         Height          =   285
         Index           =   2
         Left            =   240
         TabIndex        =   5
         Text            =   "F"
         Top             =   1200
         Width           =   1215
      End
      Begin VB.TextBox ValueText 
         Height          =   285
         Index           =   2
         Left            =   1560
         TabIndex        =   6
         Text            =   "3"
         Top             =   1200
         Width           =   1215
      End
      Begin VB.TextBox NameText 
         Height          =   285
         Index           =   3
         Left            =   240
         TabIndex        =   7
         Text            =   "D"
         Top             =   1560
         Width           =   1215
      End
      Begin VB.TextBox ValueText 
         Height          =   285
         Index           =   3
         Left            =   1560
         TabIndex        =   8
         Text            =   "10"
         Top             =   1560
         Width           =   1215
      End
      Begin VB.TextBox NameText 
         Height          =   285
         Index           =   4
         Left            =   240
         TabIndex        =   9
         Top             =   1920
         Width           =   1215
      End
      Begin VB.TextBox ValueText 
         Height          =   285
         Index           =   4
         Left            =   1560
         TabIndex        =   10
         Top             =   1920
         Width           =   1215
      End
      Begin VB.Label Label1 
         Appearance      =   0  'Flat
         Caption         =   "Name"
         ForeColor       =   &H80000008&
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   14
         Top             =   240
         Width           =   615
      End
      Begin VB.Label Label1 
         Appearance      =   0  'Flat
         Caption         =   "Value"
         ForeColor       =   &H80000008&
         Height          =   255
         Index           =   1
         Left            =   1560
         TabIndex        =   13
         Top             =   240
         Width           =   615
      End
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "如果N<M和N>F 那么就为3+M的值"
      Height          =   180
      Left            =   360
      TabIndex        =   19
      Top             =   1800
      Width           =   2520
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "如果N>M和N>F  那么就为3+N的值"
      Height          =   180
      Left            =   360
      TabIndex        =   18
      Top             =   1080
      Width           =   2610
   End
   Begin VB.Label Label2 
      Appearance      =   0  'Flat
      Caption         =   "Expression"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   0
      TabIndex        =   17
      Top             =   0
      Width           =   975
   End
   Begin VB.Label Label3 
      Appearance      =   0  'Flat
      Caption         =   "Result"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   480
      TabIndex        =   16
      Top             =   4200
      Width           =   615
   End
   Begin VB.Label ResultLabel 
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   1200
      TabIndex        =   15
      Top             =   4200
      Width           =   1215
   End
End
Attribute VB_Name = "ExpressionForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Primitives As CollectionPrivate Function EvaluateExpr(ByVal Expr As String) As StringConst PREC_NONE = 11Const PREC_UNARY = 10 ' Not actually used.Const PREC_POWER = 9Const PREC_TIMES = 8Const PREC_DIV = 7Const PREC_INT_DIV = 6Const PREC_MOD = 5Const PREC_PLUS = 4
Dim is_unary As BooleanDim next_unary As BooleanDim parens As IntegerDim pos As IntegerDim expr_len As IntegerDim ch As StringDim lexpr As StringDim rexpr As StringDim value As StringDim status As LongDim best_pos As IntegerDim best_prec As IntegerDim v As Variant' Remove leading and trailing blanks.Expr = Trim$(Expr)expr_len = Len(Expr)If expr_len = 0 Then Exit Function

Answer 3

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_unaryElseIf ch = "(" Then' Increase the open parentheses count.parens = parens + 1
' An operator after "(" is unary.next_unary = TrueElseIf ch = ")" Then
parens = parens - 1
next_unary = True
If parens < 0 ThenErr.Raise vbObjectError + 1001, "EvaluateExpr", "Too many )s in '" & Expr & "'"End IfElseIf parens = 0 Then' See if this is an operator.If ch = "^" Or ch = "*" Or _
ch = "/" Or 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 chCase "^"If best_prec >= PREC_POWER Thenbest_prec = PREC_POWERbest_pos = posEnd IfCase "<", ">"If best_prec >= PREC_MOD Thenbest_prec = PREC_MODbest_pos = posEnd If
Case "*", "/"If best_prec >= PREC_TIMES Thenbest_prec = PREC_TIMESbest_pos = posEnd If
Case "\"If best_prec >= PREC_INT_DIV Thenbest_prec = PREC_INT_DIVbest_pos = posEnd If
Case "%"If best_prec >= PREC_MOD Thenbest_prec = PREC_MODbest_pos = posEnd If
Case "+", "-"' Ignore unary operators' for now.If (Not is_unary) And best_prec >= PREC_PLUS Thenbest_prec = PREC_PLUSbest_pos = posEnd IfEnd SelectEnd IfEnd Ifis_unary = next_unaryNext pos
' If the parentheses count is not zero,' there's a ')' missing.If parens <> 0 ThenErr.Raise vbObjectError + 1002, "EvaluateExpr", "Missing ) in '" & Expr & "'"End If
' Hopefully we have the operator.If best_prec < PREC_NONE Thenlexpr = 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 ">"
If EvaluateExpr(rexpr) > EvaluateExpr(lexpr) Then
EvaluateExpr = 1
ElseEvaluateExpr = 0End If
Case "+"EvaluateExpr = Val(EvaluateExpr(lexpr)) + Val(EvaluateExpr(rexpr)) '求教当n的值为空值时,解决类型错误的问题，谢谢Case "-"EvaluateExpr = EvaluateExpr(lexpr) - EvaluateExpr(rexpr)End SelectExit FunctionEnd IfIf Left$(Expr, 1) = "(" And Right$(Expr, 1) = ")" Then' Remove the parentheses.EvaluateExpr = EvaluateExpr(Mid$(Expr, 2, expr_len - 2))Exit FunctionEnd If

Answer 4

' Look for -expr2.If Left$(Expr, 1) = "-" ThenEvaluateExpr = -EvaluateExpr(Right$(Expr, expr_len - 1))Exit FunctionEnd If
' Look for +expr2.If Left$(Expr, 1) = "+" ThenEvaluateExpr = EvaluateExpr(Right$(Expr, expr_len - 1))Exit FunctionEnd If
' Look for Fun(expr2).If expr_len > 5 And Right$(Expr, 1) = ")" Then lexpr = LCase$(Left$(Expr, InStr(Expr, "(")))
 
 rexpr = Mid$(Expr, InStr(Expr, "(") + 1, expr_len - InStr(Expr, "(") - 1)Select Case lexprCase "sin("EvaluateExpr = Sin(EvaluateExpr(rexpr))Exit FunctionCase "cos("EvaluateExpr = Cos(EvaluateExpr(rexpr))Exit FunctionCase "tan("EvaluateExpr = Tan(EvaluateExpr(rexpr))Exit FunctionCase "sqr("EvaluateExpr = Sqr(EvaluateExpr(rexpr))Exit FunctionCase "sum("v = SplitParams(rexpr)
EvaluateExpr = sum(EvaluateExpr(v(0)), EvaluateExpr(v(1)))Exit FunctionCase "if(" v = SplitParams(rexpr)
 
 EvaluateExpr = iff(EvaluateExpr(v(0)), EvaluateExpr(v(1)), EvaluateExpr(v(2)))
 
 Exit FunctionEnd SelectEnd If
' See if it's a primitive.On Error Resume Nextvalue = Primitives.Item(Expr)
status = Err.Number
On Error GoTo 0If status = 0 Then
If value = "" Then
EvaluateExpr = 0
Exit Function
End IfEvaluateExpr = CSng(value)Exit FunctionEnd If
' It must be a literal like "2.71828".On Error Resume NextEvaluateExpr = CSng(Expr)status = Err.NumberOn Error GoTo 0If status <> 0 ThenErr.Raise status, "EvaluateExpr", "Error evaluating '" & Expr & "' as a constant."End IfEnd Function' ************************************************' Evaluate the expression entered by the user.' ************************************************Private Sub CmdEvaluate_Click()Dim i As IntegerDim name As StringDim value As StringDim Expr As StringDim rslt As SingleDim pos As Integer
' Store the primitives.Set Primitives = New CollectionFor i = 0 To 4name = Trim$(NameText(i).Text)value = Trim$(ValueText(i).Text)If name <> "" ThenPrimitives.Add value, nameEnd IfNext i
' Get the expression.Expr = ExprText.Text
' Evaluate the expression.ResultLabel.Caption = ""On Error GoTo EvaluateErrorrslt = EvaluateExpr(Expr)ResultLabel.Caption = Format$(rslt)Exit Sub
EvaluateError:BeepMsgBox Err.DescriptionEnd SubPrivate Function SplitParams(ByVal Expr As String) As String()
    Dim a() As String
    Dim lCount As Long
    Dim ch As String
    Dim lParanCount As Long
    Dim iStart As Long
    Dim i As Long
                           
    iStart = 1
    For i = 1 To Len(Expr)
        ch = Mid$(Expr, i, 1)
        Select Case ch
            Case "("
                lParanCount = lParanCount + 1
            Case ")"
                lParanCount = lParanCount - 1
            Case ","
                If lParanCount = 0 Then
                    lCount = lCount + 1
                    ReDim Preserve a(lCount - 1)
                    a(lCount - 1) = Mid$(Expr, iStart, i - iStart)
                    iStart = i + 1
                End If
        End Select
    Next
    If i > iStart Then
        lCount = lCount + 1
        ReDim Preserve a(lCount - 1)
        a(lCount - 1) = Mid$(Expr, iStart, i - iStart)
        iStart = i + 1
    End If
    
    SplitParams = a
End Function
Private Function sum(x As String, n As Integer) As String sum = Val(x) + n
End FunctionPrivate Function iff(x As String, n As String, c As String) As String
If Val(x) = 1 Then
iff = n
End If
If Val(x) = 0 Then
iff = c
End If
End Function

Answer 5

Private Function EvaluateExpr(ByVal Expr As String) As String里
.
.
.Case "if("v = SplitParams(rexpr)EvaluateExpr = iff(EvaluateExpr(v(0)), EvaluateExpr(v(1)), EvaluateExpr(v(2)))Exit FunctionEnd Select
这部分里并没有处理 and的功能，自己写吧。

Answer 6

高手啊，由于and 不知是出现在if中，还会出现在其它的地方。
我想知道的是：
1 逻辑运算符 and or 等和+ - * / 的先后顺序
2 如何能使and or 也如下面处理 ：
Case "*" EvaluateExpr = EvaluateExpr(lexpr) * EvaluateExpr(rexpr) Case "/" EvaluateExpr = EvaluateExpr(lexpr) / EvaluateExpr(rexpr) 谢谢！！！

Answer 7

你的代码太乱了，让人看得头痛……
注意一下格式啊！答一下这里的“问题1”吧：
VB 中的运算优先级是：
数学运算 > 比较运算 > 逻辑运算
比较运算指：> ,  <  , >=  , <> , = 等等。逻辑运算：Not > And > (Or , Xor)
　　　　Or 和 Xor 是平级的。

Answer 8

这样的语法太复杂，其实你可以参考一下 Excel 的公式，它是将 AND 和 OR 作为函数处理的。表达式
  SUM(3+IF(N>M AND N>F,N,M),D)
写成可供运算的表达式就成了
  SUM(3+IF(AND(N>M,N>F),N,M),D)只要加上 AND() 函数的处理代码就成了。

Answer 9

1.and/or 与其他运算符不明确关系的时候,用()就可以了, ()的优先级比较高
2.你可以直接用
Case "*","/"
EvaluateExpr = EvaluateExpr(lexpr) * EvaluateExpr(rexpr)

Answer 10

谢谢！！！特别是Tiger_Zhao：用你的想法，可解决问题，谢谢！！！

Answer 11

有个地方工更改一下：
'Case "not("
'    EvaluateExpr = Not (EvaluateExpr(rexpr))
'    Exit Function
' 上面更正为：
Case "not("
    EvaluateExpr = Not EvaluateExpr(rexpr) And 1
    Exit Function另外，你的代码中：
Dim v As Variant
建议更改为：
Dim v() As String

Answer 12

Chen8013：谢谢你！！！
你可能忘法附件了，谢谢！！！

Answer 13

不好意思，确实是我的错。已经重新发送邮件了，这次不会错啦…… 
工程中的测试表达式，已经更改了：
原来的：　SUM(3 + IF(N>M AND N>F, N, M), D)
已改成：　SUM(3 + IF(Not(and(N>M, N>F)), N, M), D)当然，函数名是不区分大小写的，因为你已经 LCase$() 了嘛，郁闷的是，这修改工作，今天是全部重新来过…………