无括号的四则混合运算
因为前段时间有一个在文本框输入公式，自动计算结果的问题。https://bbs.bccn.net/viewthread.php?tid=444134&page=1#pid2483797
写了一段代码来进行无括号的“+-*/”运算。想到哪儿写哪儿，实现功能，没有容错。
四个文本框，一个按钮。文本框1输入公式，文本框4输出结果，文本框2、3需要设置为多行及纵向滑标来显示中间过程。
程序代码：Option Explicit
Dim DatumStr() As String 'Array of datum in string style,use for splitting
Dim Datum() As Single 'Array of Datum in single style
Dim Operator() As String 'Array of operators
Private Sub Command1_Click()
Text2.Text = ""
Text3.Text = ""
Cal (Text1.Text)
End Sub
Private Sub Form_Load()
Text1.Text = "32+81*9/55-60*3"
End Sub
Sub Cal(Formula As String)
Dim temp As String
Dim i As Integer, S As Integer, j As Integer 'i,j for temprary using,S for the operator with the high priority
Dim M As Single 'For the operation's outcome of two data
Dim DTemp() As Single 'Array for after delete used data
Dim OTemp() As String 'Array for after delete used operator
Dim SetOK As Boolean 'Sign for assigning M to Dtemp()
Dim OutTemp As String 'String for temporary formula
Dim FirstNegative As Boolean 'Sign for the first data is negative
FirstNegative = False
temp = Formula
If Mid(Formula, 1, 1) = "-" Then
FirstNegative = True
Formula = Replace(Formula, "-", "", 1, 1)
temp = Formula
End If
temp = Replace(temp, "+", " ") 'Get formula's datum and operators
temp = Replace(temp, "-", " ")
temp = Replace(temp, "*", " ")
temp = Replace(temp, "/", " ")
DatumStr = Split(temp, " ")
ReDim Datum(UBound(DatumStr))
For i = 0 To UBound(DatumStr)
If FirstNegative = True And i = 0 Then
Datum(i) = Val("-" & DatumStr(i))
Else
Datum(i) = Val(DatumStr(i))
End If
Next
temp = ""
For i = 1 To Len(Formula)
If Mid(Formula, i, 1) = "+" Or Mid(Formula, i, 1) = "-" Or Mid(Formula, i, 1) = "*" Or Mid(Formula, i, 1) = "/" Then temp = temp & Mid(Formula, i, 1)
Next
ReDim Operator(Len(temp) - 1)
For i = 0 To UBound(Operator)
Operator(i) = Mid(temp, i + 1, 1)
Text2.Text = Text2.Text & Operator(i) & " "
Next
Text2.Text = Text2.Text & vbCrLf
S = 0 'Get the operator with the high priority
For i = 0 To UBound(Operator)
If Operator(i) = "*" Or Operator(i) = "/" Then
S = i
Exit For
End If
Next
Select Case Operator(S) 'calculate
Case Is = "+"
M = Datum(S) + Datum(S + 1)
Case Is = "-"
M = Datum(S) - Datum(S + 1)
Case Is = "*"
M = Datum(S) * Datum(S + 1)
Case Is = "/"
M = Datum(S) / Datum(S + 1)
End Select
If UBound(Datum) = 1 Then 'judge if exit cal function.Datum() only has two datum.
Text4.Text = M
Exit Sub
End If
ReDim DTemp(UBound(Datum) - 1) 'Recompose the rest datum and operators ,get a new formula and call cal function once more.
ReDim OTemp(UBound(Operator) - 1)
For i = 0 To UBound(Datum)
If i = S Or i = S + 1 Then
If SetOK = False Then DTemp(j) = M: SetOK = True: j = j + 1
Else
DTemp(j) = Datum(i)
j = j + 1
End If
Next
j = 0
For i = 0 To UBound(Operator)
If i <> S Then
OTemp(j) = Operator(i)
j = j + 1
End If
Next
For i = 0 To UBound(OTemp)
OutTemp = OutTemp & DTemp(i) & OTemp(i)
Next
OutTemp = OutTemp & DTemp(i)
Text3.Text = Text3.Text & OutTemp & vbCrLf
Cal (OutTemp)
End Sub
Dim DatumStr() As String 'Array of datum in string style,use for splitting
Dim Datum() As Single 'Array of Datum in single style
Dim Operator() As String 'Array of operators
Private Sub Command1_Click()
Text2.Text = ""
Text3.Text = ""
Cal (Text1.Text)
End Sub
Private Sub Form_Load()
Text1.Text = "32+81*9/55-60*3"
End Sub
Sub Cal(Formula As String)
Dim temp As String
Dim i As Integer, S As Integer, j As Integer 'i,j for temprary using,S for the operator with the high priority
Dim M As Single 'For the operation's outcome of two data
Dim DTemp() As Single 'Array for after delete used data
Dim OTemp() As String 'Array for after delete used operator
Dim SetOK As Boolean 'Sign for assigning M to Dtemp()
Dim OutTemp As String 'String for temporary formula
Dim FirstNegative As Boolean 'Sign for the first data is negative
FirstNegative = False
temp = Formula
If Mid(Formula, 1, 1) = "-" Then
FirstNegative = True
Formula = Replace(Formula, "-", "", 1, 1)
temp = Formula
End If
temp = Replace(temp, "+", " ") 'Get formula's datum and operators
temp = Replace(temp, "-", " ")
temp = Replace(temp, "*", " ")
temp = Replace(temp, "/", " ")
DatumStr = Split(temp, " ")
ReDim Datum(UBound(DatumStr))
For i = 0 To UBound(DatumStr)
If FirstNegative = True And i = 0 Then
Datum(i) = Val("-" & DatumStr(i))
Else
Datum(i) = Val(DatumStr(i))
End If
Next
temp = ""
For i = 1 To Len(Formula)
If Mid(Formula, i, 1) = "+" Or Mid(Formula, i, 1) = "-" Or Mid(Formula, i, 1) = "*" Or Mid(Formula, i, 1) = "/" Then temp = temp & Mid(Formula, i, 1)
Next
ReDim Operator(Len(temp) - 1)
For i = 0 To UBound(Operator)
Operator(i) = Mid(temp, i + 1, 1)
Text2.Text = Text2.Text & Operator(i) & " "
Next
Text2.Text = Text2.Text & vbCrLf
S = 0 'Get the operator with the high priority
For i = 0 To UBound(Operator)
If Operator(i) = "*" Or Operator(i) = "/" Then
S = i
Exit For
End If
Next
Select Case Operator(S) 'calculate
Case Is = "+"
M = Datum(S) + Datum(S + 1)
Case Is = "-"
M = Datum(S) - Datum(S + 1)
Case Is = "*"
M = Datum(S) * Datum(S + 1)
Case Is = "/"
M = Datum(S) / Datum(S + 1)
End Select
If UBound(Datum) = 1 Then 'judge if exit cal function.Datum() only has two datum.
Text4.Text = M
Exit Sub
End If
ReDim DTemp(UBound(Datum) - 1) 'Recompose the rest datum and operators ,get a new formula and call cal function once more.
ReDim OTemp(UBound(Operator) - 1)
For i = 0 To UBound(Datum)
If i = S Or i = S + 1 Then
If SetOK = False Then DTemp(j) = M: SetOK = True: j = j + 1
Else
DTemp(j) = Datum(i)
j = j + 1
End If
Next
j = 0
For i = 0 To UBound(Operator)
If i <> S Then
OTemp(j) = Operator(i)
j = j + 1
End If
Next
For i = 0 To UBound(OTemp)
OutTemp = OutTemp & DTemp(i) & OTemp(i)
Next
OutTemp = OutTemp & DTemp(i)
Text3.Text = Text3.Text & OutTemp & vbCrLf
Cal (OutTemp)
End Sub
