• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 551
  • Last Modified:

Evaluating Expressions

If I have a string that is something like "5+7*2^2" is there a function that will evaluate it and return a 33?
0
hess
Asked:
hess
1 Solution
 
tureCommented:
hess,

Yes. If Excel is installed on the computer you can use Evaluate which is included in Excel VBA.

1. Add a reference to the Excel object library.
2. Try this code:

   Private Sub Command1_Click()
     MsgBox Excel.Evaluate("5+7*2^2")
   End Sub

Ture Magnusson
Karlstad, Sweden
0
 
mdouganCommented:
I don't know of a VB function, however there is a company called VideoSoft who makes controls.  They have one called AWK, which is bundled inside of their VSOCX control.  AWK does a couple of things.  One, it is a useful tool for parsing string, and the other is that it can evaluate string expressions.  You can download a demo from WWW.VideoSoft.Com

0
 
deeznutzCommented:
You can reference the Micorsoft Access Object for your project and use the Access eval statement. i.e after your referenced the Microsoft Access 8.0 Object Library, use the statment eval("5+7*2^2") which will do what you want it to do.
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
tureCommented:
hess,

Note that the answer posted by deeznutz is the same approach that I posted a few hours ago, the only difference is that deeznutz chooses to use the Access object library instead of the Excel object library.

/Ture
0
 
smeggheadCommented:
Here's a completely SILLY answer... (or comment)

dim db as database
dim rs as recordset
dim calc as string
set db=dbengine.workspaces(0).opendatabase("c:\fred.mdb")
calc="5+7*2^2"
set rs=db.openrecordset("select "+calc+" from [TableWithOneRecord]")
msgbox "Result = "+format$(rs.fields(0))
rs.close
db.close

For this to work, you must have a table with not too many records in it, but at least one.

I don't recommend using this method - use ture's

Good luck Ture, hope he rejects and allows you to post your comment as an answer.
0
 
deeznutzCommented:
Yep, sorry my answer is basicaly the same as the comment added.
0
 
deightonCommented:
Option Explicit
Dim e_input As String     ' Expression input string.
Dim e_tok As String       ' Current token kind.
Dim e_spelling As String  ' Current token spelling.
Dim e_error As Integer    ' Tells if syntax error occurred.

Function e_eval(ByVal s As String, value As Double) As Integer
   ' Initialize.
   e_error = 0
   e_input = s
   Call e_nxt
 
   ' Evaluate.
   value = e_prs(1)
 
   ' Check for unrecognized input.
   If e_tok <> "" And Not e_error Then
      MsgBox "syntax error, token = '" + e_spelling + "'"
   e_error = -1
   End If
 
   e_eval = Not e_error
End Function
 
' e_prs
'   Parse an expression, allowing operators of a specified
'   precedence or higher. The lowest precedence is 1.
'   This function gets tokens with e_nxt and recursively
'   applies operator precedence rules.
Function e_prs(p As Integer) As Double
   Dim n As Double    ' Return value.
   Dim fun As String  ' Function name.
 
   ' Parse expression that begins with a token (precedence 12).
   If e_tok = "num" Then
      ' number.
      n = Val(e_spelling)
      Call e_nxt
   ElseIf e_tok = "-" Then
      ' unary minus.
      Call e_nxt
      n = -e_prs(11)    ' Operand precedence 11.
   ElseIf e_tok = "not" Then
      ' logical NOT.
      Call e_nxt
      n = Not e_prs(6)  ' Operand precedence 6.
   ElseIf e_tok = "(" Then
      ' parentheses.
      Call e_nxt
      n = e_prs(1)
      Call e_match(")")
   ElseIf e_tok = "id" Then
      ' Function call.
      fun = e_spelling
      Call e_nxt
      Call e_match("(")
      n = e_prs(1)
      Call e_match(")")
      n = e_function(fun, n)
   Else
      If Not e_error Then
         MsgBox "syntax error, token = '" + e_spelling + "'"
         e_error = -1
      End If
   End If
 
   ' Parse binary operators.
Do While Not e_error
  If 0 Then  ' To allow ElseIf .
  ElseIf p <= 11 And e_tok = "^" Then: Call e_nxt: n = n ^ e_prs(12)
  ElseIf p <= 10 And e_tok = "*" Then: Call e_nxt: n = n * e_prs(11)
  ElseIf p <= 10 And e_tok = "/" Then: Call e_nxt: n = n / e_prs(11)
  ElseIf p <= 9 And e_tok = "\" Then: Call e_nxt: n = n \ e_prs(10)
  ElseIf p <= 8 And e_tok = "mod" Then: Call e_nxt: n = n Mod e_prs(9)
  ElseIf p <= 7 And e_tok = "+" Then: Call e_nxt: n = n + e_prs(8)
  ElseIf p <= 7 And e_tok = "-" Then: Call e_nxt: n = n - e_prs(8)
  ElseIf p <= 6 And e_tok = "=" Then: Call e_nxt: n = n = e_prs(7)
  ElseIf p <= 6 And e_tok = "<" Then: Call e_nxt: n = n < e_prs(7)
  ElseIf p <= 6 And e_tok = ">" Then: Call e_nxt: n = n > e_prs(7)
  ElseIf p <= 6 And e_tok = "<>" Then: Call e_nxt: n = n <> e_prs(7)
  ElseIf p <= 6 And e_tok = "<=" Then: Call e_nxt: n = n <= e_prs(7)
  ElseIf p <= 6 And e_tok = ">=" Then: Call e_nxt: n = n >= e_prs(7)
  ElseIf p <= 5 And e_tok = "and" Then: Call e_nxt: n = n And e_prs(6)
  ElseIf p <= 4 And e_tok = "or" Then: Call e_nxt: n = n Or e_prs(5)
  ElseIf p <= 3 And e_tok = "xor" Then: Call e_nxt: n = n Xor e_prs(4)
  ElseIf p <= 2 And e_tok = "eqv" Then: Call e_nxt: n = n Eqv e_prs(3)
  ElseIf p <= 1 And e_tok = "imp" Then: Call e_nxt: n = n Imp e_prs(2)
  Else
       Exit Do
  End If
 Loop
 
   e_prs = n
End Function
 
' e_function.
'   Evaluate a function. This is a helper function to simplify
'   e_prs.
Function e_function(fun As String, arg As Double) As Double
   Dim n As Double
 
   Select Case LCase$(fun)
   Case "abs": n = Abs(arg)
   Case "atn": n = Atn(arg)
   Case "cos": n = Cos(arg)
   Case "exp": n = Exp(arg)
   Case "fix": n = Fix(arg)
   Case "int": n = Int(arg)
   Case "log": n = Log(arg)
   Case "rnd": n = Rnd(arg)
   Case "sgn": n = Sgn(arg)
   Case "sin": n = Sin(arg)
   Case "sqr": n = Sqr(arg)
   Case "tan": n = Tan(arg)
   
   
   'New functions
   Case "arccos": n = arccos(arg)
   Case "arcsin": n = arcsin(arg)
   
   Case "arcsec": n = arcsec(arg)
   Case "arccosec": n = arccosec(arg)
   Case "arccot": n = arccot(arg)
   
   Case "cot": n = cot(arg)
   Case "cosec": n = cosec(arg)
   Case "sec": n = sec(arg)
   
   Case "sinh": n = sinh(arg)
   Case "cosh": n = cosh(arg)
   Case "tanh": n = tanh(arg)
   
   Case "arcsinh": n = arcsinh(arg)

   Case "coth": n = coth(arg)
   Case "cosech": n = cosech(arg)
   Case "sech": n = sech(arg)


   Case Else
      If Not e_error Then
         MsgBox "undefined function '" + fun + "'"
         e_error = -1
      End If
   End Select
 
   e_function = n
End Function


Private Function arccos(ByVal x As Double) As Double
   
    If Abs(x) = 1 Then
   
        If x = 1 Then arccos = 0 Else arccos = Atn(1) * 4
   
    Else
   
        arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)

    End If
   
End Function
   
Private Function arcsec(ByVal x As Double) As Double
   
    arcsec = arccos(1 / x)
   
End Function

Private Function arcsinh(ByVal x As Double) As Double
   
    arcsinh = Log(x + Sqr(x * x + 1))
       
End Function

Private Function arccosec(ByVal x As Double) As Double
   
    arccosec = arcsin(1 / x)
   
End Function

Private Function arccot(ByVal x As Double) As Double
   
    arccot = Atn(1 / x)

   
End Function

Private Function sec(ByVal x As Double) As Double
   
    sec = 1 / Cos(x)
       
End Function

Private Function cot(ByVal x As Double) As Double
   
    cot = 1 / Tan(x)
       
End Function

Private Function cosec(ByVal x As Double) As Double
   
     cosec = 1 / Sin(x)
       
End Function


Private Function sinh(ByVal x As Double) As Double
   
    sinh = (Exp(x) - Exp(-x)) / 2
           
End Function

Private Function cosh(ByVal x As Double) As Double
   
    cosh = (Exp(x) + Exp(-x)) / 2
           
End Function

Private Function tanh(ByVal x As Double) As Double
   
    tanh = sinh(x) / cosh(x)
           
End Function

Private Function coth(ByVal x As Double) As Double
   
    coth = 1 / tanh(x)
           
End Function

Private Function sech(ByVal x As Double) As Double
   
    sech = 1 / cosh(x)
           
End Function

Private Function cosech(ByVal x As Double) As Double
   
    cosech = 1 / sinh(x)
           
End Function

Private Function arcsin(ByVal x As Double) As Double
   
    If Abs(x) = 1 Then
   
        arcsin = Atn(1) * 2 * Sgn(x)
   
    Else
   
        arcsin = Atn(x / Sqr(-x * x + 1))

    End If
   
End Function
   
   
 
' e_nxt
'   Get the next token into e_tok and e_spelling and remove the
'   token from e_input.
'   This function groups the input into "words" like numbers,
'   operators and function names.
Sub e_nxt()
   Dim is_keyword As Integer
   Dim c As String  ' Current input character.
   Dim is_id As Integer
 
   e_tok = ""
   e_spelling = ""
 
   ' Skip whitespace.
   Do
      c = Left$(e_input, 1)
      e_input = Mid$(e_input, 2)
   Loop While c = " " Or c = Chr$(9) Or c = Chr$(13) Or c = Chr$(10)
 
   Select Case LCase$(c)
 
   ' Number constant. Modify this to support hexadecimal, etc.
   Case "0" To "9", "."
      e_tok = "num"
      Do
         e_spelling = e_spelling + c
         c = Left$(e_input, 1)
         e_input = Mid$(e_input, 2)
      Loop While (c >= "0" And c <= "9") Or c = "."
      e_input = c + e_input
 
   ' Identifier or keyword.
   Case "a" To "z", "_"
      e_tok = "id"
      Do
         e_spelling = e_spelling + c
         c = LCase$(Left$(e_input, 1))
         e_input = Mid$(e_input, 2)
         is_id = (c >= "a" And c <= "z")
         is_id = is_id Or c = "_" Or (c >= "0" And c <= "9")
      Loop While is_id
      e_input = c + e_input
 
      ' Check for keyword.
      is_keyword = -1
      Select Case LCase$(e_spelling)
         Case "and"
         Case "eqv"
         Case "imp"
         Case "mod"
         Case "not"
         Case "or"
         Case "xor"
         Case Else: is_keyword = 0
      End Select
      If is_keyword Then
         e_tok = LCase$(e_spelling)
      End If
 
   ' Check for <=, >=, <>.
   Case "<", ">"
      e_tok = c
      c = Left$(e_input, 1)
      If c = "=" Or c = ">" Then
         e_tok = e_tok + c
         e_input = Mid$(e_input, 2)
      End If
 
   ' Single character token.
   Case Else
      e_tok = c
   End Select
 
    If e_spelling = "" Then
       e_spelling = e_tok
   End If
End Sub
 
' e_match
'   Check the current token and skip past it.
'   This function helps with syntax checking.
Sub e_match(token As String)
   If Not e_error And e_tok <> token Then
      MsgBox "expected " + token + ", got '" + e_spelling + "'"
      e_error = -1
   End If
   Call e_nxt
End Sub
Private Sub Command1_Click()
   
       Dim n As Double
 
       If e_eval(Text1.Text, n) Then
         Label3.Caption = Format$(n)
       End If
   
End Sub



0

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now