Private Type Parent
s As String
value As Double
End Type

Private Type Plus
s As String
value As Double
End Type

'下面是實現此功能的函數的定義
Public Function ValueOfExpression(ByVal Express As String) As Double
Dim Pa() As Parent, ParNum As Integer, Ps() As Plus, OperNum As Integer
Dim str0 As String

'按括號分解表達式 Express:Begin-----/*
Dim lenExp As Integer, Lenstr1 As Integer, i As Integer, j As Integer, k As Integer, str1 As String, str2 As String, intPar As Integer
Dim intStart As Integer, intEnd As Integer
lenExp = Len(Express)

For i = 1 To lenExp
If Mid(Express, i, 1) = "(" Then intPar = intPar + 1
Next

ParNum = intPar
ReDim Pa((intPar / 10 + 1) * 10)

For i = 1 To intPar
If intPar < 1 Then Exit For
For j = 1 To lenExp
If Mid(Express, j, 1) = ")" Then
str1 = Mid(Express, 1, j - 1)
Exit For
End If
Next
Lenstr1 = Len(str1)
For k = 1 To Lenstr1
If Mid(str1, Lenstr1 + 1 - k, 1) = "(" Then
Pa(i).s = Mid(str1, Lenstr1 + 2 - k)
Exit For
End If
Next
Express = Mid(Express, 1, Lenstr1 - k) & Chr(128) & CStr(i) & Mid(Express, j + 1)
lenExp = Len(Express)
Next

Pa(0).s = Express
'*/-----End

'按加減號進一步分解：Begin-----/*
Dim n As Integer, strLeft As String
For i = 0 To ParNum
k = 0
For j = 1 To Len(Pa(i).s)
str1 = Mid(Pa(i).s, j, 1)
If str1 = "+" Or str1 = "-" Then k = k + 1
Next
If k > OperNum Then OperNum = k
Next
ReDim Ps(ParNum, OperNum)
For i = 0 To ParNum
strLeft = Pa(i).s: n = 0: str2 = ""
Do
If Len(strLeft) = 0 Then Exit Do
For j = 1 To Len(strLeft)
str1 = Mid(strLeft, j, 1)
If str1 = "+" Or str1 = "-" Then
Ps(i, n).s = str2 & Mid(strLeft, 1, j - 1)
n = n + 1
str2 = IIf(str1 = "-", str1, "")
strLeft = Mid(strLeft, j + 1)
Exit For
End If
If j = Len(strLeft) Then
Ps(i, n).s = str2 & strLeft: j = 0
Exit For
End If
Next
Loop Until j = 0
Next
'*/-----End

'計算最后分成的多個簡單表達式的值的總和,即表達式 Express 的值
Dim Total As Double, value As Double
For i = 1 To ParNum + 1
If i = ParNum + 1 Then i = 0
Total = 0
For j = 0 To OperNum
Express = Ps(i, j).s: value = 0
Dim lasti As Integer, operator As String
lenExp = Len(Express): lasti = 0: operator = ""
For k = 1 To lenExp
str0 = Mid(Express, k, 1)
If InStr("*/^", str0) > 0 Or k = lenExp Then
If k = lenExp Then k = k + 1
str1 = Mid(Express, lasti + 1, k - 1 - lasti)
Dim sign As Integer, Valstr1 As Double
If Mid(str1, 1, 1) = "-" Then
sign = -1
str1 = Mid(str1, 2)
Else
sign = 1
End If
n = InStr(1, "/sin" & Chr(128) & "/cos" & Chr(128) & "/tan" & Chr(128) & "/abs" & Chr(128) & "/atn" & Chr(128) & "/exp" & Chr(128) & "/int" & Chr(128) & "/fix" & Chr(128) & "/sgn" & Chr(128) & "/sqr" & Chr(128) & "/", "/" & Mid(str1, 1, 4) & "/")
If n > 0 Then
Valstr1 = Choose((n + 4) / 5, Sin(Pa(Val(Mid(str1, 5))).value), Cos(Pa(Val(Mid(str1, 5))).value), Tan(Pa(Val(Mid(str1, 5))).value), Abs(Pa(Val(Mid(str1, 5))).value), Atn(Pa(Val(Mid(str1, 5))).value), Exp(Pa(Val(Mid(str1, 5))).value), Int(Pa(Val(Mid(str1, 5))).value), Fix(Pa(Val(Mid(str1, 5))).value), Sgn(Pa(Val(Mid(str1, 5))).value), Sqr(Pa(Val(Mid(str1, 5))).value))
Else
n = InStr(1, "/lg" & Chr(128) & "/ln" & Chr(128) & "/", Mid(str1, 1, 3))
If n > 0 Then
Valstr1 = Choose((n + 3) / 4, Log(Pa(Val(Mid(str1, 4))).value) / Log(10), Log(Pa(Val(Mid(str1, 4))).value))
Else
If Mid(str1, 1, 1) = Chr(128) Then
Valstr1 = Pa(Val(Mid(str1, 2))).value
ElseIf Right(str1, 1) = "!" Then
If Val(str1) = 0 Then
Valstr1 = 1
Else
Valstr1 = 1
For n = 1 To Val(str1)
Valstr1 = Valstr1 * n
Next
End If
Else
Valstr1 = Val(str1)
End If
End If
End If
Valstr1 = Valstr1 * sign
Select Case operator
Case ""
value = Valstr1
Case "*"
value = value * Valstr1
Case "/"
value = value / Valstr1
Case "^"
value = value ^ Valstr1
End Select
lasti = k: operator = str0
End If
Next
Ps(i, j).value = value
Total = Total + Ps(i, j).value
Next
Pa(i).value = Total
If i = 0 Then Exit For
Next
ValueOfExpression = Pa(0).value
End Function

'使用例子：
'在Text1中輸入式子，然后：
'Text2.Text=ValueOfExpression(Text1.Text)

'該函數支持很多數學函數如sin、cos、tan等等，如：
'Print ValueOfExpression("sin(1)")
'注意后面要加括號
'該函數支持運算符+-*/^!，還有括號，^為乘冪，其優先級與*/相同，這是使用該函數需要注意的地方；!為階乘

on command1_click()
計算之后
text2.text = 計算結果 ...