|
給一段有四則運算的代碼給您參考一下
Dim val_Str() As String
Dim Resu As Double
Dim iP_N() As Integer '用于判數据的正負
Dim sSt() As String * 1
Dim Kuohao() As Integer
Function calc_Kuohao(str_tex As String) As Double '括號計算
Dim text_strr As String
Dim mm_stR As String
Dim i_len As Long
Dim aa As String
Dim Str_Text1 As String
Dim ii As Long
Dim i As Long
Dim ceng As String
Dim zuiD As Long
Dim id As Long
Dim mm As String
Dim resu_str As Long
text_strr = Trim(str_tex)
i_len = Len(text_strr)
aa = Mid(text_strr, 1, 1)
If aa = "-" Or aa = "+" Or aa = "*" Or aa = "/" Then Str_Text1 = "0" & text_strr
ii = 0
For i = 1 To i_len '判斷括號是否成對
mm_stR = Mid(text_strr, i, 1)
If mm_stR = "(" Then ii = ii + 1
If mm_stR = ")" Then ii = ii - 1
If ii < 0 Then
MsgBox ("括號不成對")
Exit Function
End If
Next
If ii <> 0 Then '
MsgBox ("括號不成對")
Exit Function
End If
If InStr(1, text_strr, "(") > 0 Then '如果有括號,現按最里層括號計算
ReDim sSt(1 To Len(text_strr))
ReDim Kuohao(1 To Len(text_strr))
Do While True
i_len = Len(Trim(text_strr))
ceng = 1
For i = 1 To i_len
sSt(i) = Mid(text_strr, i, 1)
Next
If InStr(1, text_strr, "(") <> 0 And InStr(1, text_strr, "(") <> 0 Then '計算有多少個括號,不成對返回0
text_strr = ""
For i = 1 To i_len '判斷括號是否為0
text_strr = text_strr & sSt(i)
Next
For i = 1 To i_len
Kuohao(i) = 0 '清零
If sSt(i) = "(" Then
Kuohao(i) = ceng
ceng = ceng + 1
End If
If sSt(i) = ")" Then
ceng = ceng - 1
Kuohao(i) = ceng
End If
Next
zuiD = 0: id = 1
For i = 1 To i_len '求最里層括號
If Kuohao(i) > zuiD Then
zuiD = Kuohao(i)
id = i
End If
Next 'kuohao(iD)最里層
mm = InStr(id, text_strr, ")")
If mm <> 0 Then 'mm=")"
mm_stR = Mid(text_strr, id + 1, mm - id - 1)
resu_str = cacul_Str(mm_stR) '計算
text_strr = Mid(text_strr, 1, id - 1) & resu_str & Mid(text_strr, mm + 1, i_len - mm)
Else
Exit Do
End If
Else
text_strr = ""
For i = 1 To i_len '判斷括號是否為0
text_strr = text_strr & sSt(i)
Next
calc_Kuohao = cacul_Str(text_strr)
Exit Do
End If
Loop
Else
calc_Kuohao = cacul_Str(text_strr) '計算
End If
End Function
Function cacul_Str(ok_str As String) As Double '字符串表示式的計算,無括號
Dim s_int As Integer
Dim i As Long
Dim aa As String
Dim bb As String '不明
Dim j As Long
ReDim val_Str(Len(ok_str) + 2)
ReDim iP_N(Len(ok_str) + 1)
aa = Mid(ok_str, i + 1, 1)
If aa = "-" Or aa = "+" Or aa = "*" Or aa = "/" Then ok_str = "0" & ok_str
s_int = 0
val_Str(0) = ""
For i = 0 To Len(ok_str)
iP_N(i) = 1
Next
i = 0
Do While i < Len(ok_str) '含分解字符串
aa = Mid(ok_str, i + 1, 1)
bb = Asc(aa)
If bb >= 48 And bb <= 57 Or bb = 46 Then '0-9 and .
val_Str(s_int) = val_Str(s_int) & aa
Else
If aa = "+" Or aa = "-" Or aa = "*" Or aa = "/" Then
If Mid(ok_str, i + 2, 1) = "-" Then
iP_N(s_int + 2) = -1
ok_str = Mid(ok_str, 1, i + 1) & Mid(ok_str, i + 3, Len(ok_str))
ok_str = Trim(ok_str)
i = i - 1
Else
s_int = s_int + 1
val_Str(s_int) = aa
s_int = s_int + 1
val_Str(s_int) = ""
End If
Else
iP_N(s_int) = 1
End If
End If
i = i + 1
Loop
For i = 0 To s_int Step 2
val_Str(i) = Val(val_Str(i)) * iP_N(i)
Next
If s_int > 1 Then
For i = 0 To s_int Step 2
If val_Str(i + 1) = "*" Or val_Str(i + 1) = "/" Then
If val_Str(i + 1) = "*" Then
val_Str(i) = Val(val_Str(i)) * Val(val_Str(i + 2))
Else
val_Str(i) = Val(val_Str(i)) / Val(val_Str(i + 2))
End If
For j = i + 1 To s_int
val_Str(j) = val_Str(j + 2)
Next
val_Str(s_int - 1) = "": val_Str(s_int) = ""
s_in |
|