標(biāo)題: VB編寫(xiě)的根號(hào)化簡(jiǎn)程序 [打印本頁(yè)] 作者: 51hei小名 時(shí)間: 2016-6-20 22:47 標(biāo)題: VB編寫(xiě)的根號(hào)化簡(jiǎn)程序 '程序版本：V1.0 (Test)
Function Simplify (Expr)
Dim fds, SHX, Arr, i, Res, Xishu, Canshu, j, k, l, w, w2, Cans(100), Xis(100), Xi2(100), Can2(100), Xi_ON, Can_On
Arr = Split(Replace(LCase(Expr), " ", ""), "+")
Res = ""
SHX = ""
k = 0
For Each i In Arr
VZ = instr(i, "sq")
If VZ <> 0 Then
If VZ > 1 Then
xishu = CDbl(Mid(i, 1, VZ - 1))
Else
xishu = 1
End If
Canshu = CDbl(Mid(i, VZ + 3, InStr(VZ, i, ")") - VZ - 3))
For j = 1024 To 2 Step -1
If Canshu Mod (j * j) = 0 Then
xishu = xishu * j
Canshu = Canshu / (j * j)
End If
Next
Cans(k) = Canshu
Xis(k) = Xishu
Else
Cans(k) = 1
Xis(k) = CDbl(i)
'Res = Res & "+" & i
End If
K = K + 1
Next
l = 0
For i = 0 To UBound(Arr)
Xi_on = Xis(i)
Can_on = Cans(i)
If Can_on <> 0 Then
For j = 0 To UBound(Arr)
If Cans(j) = Can_on And j <> i Then
Xi_on = Xi_on + Xis(j)
Cans(j) = 0
Xis(j) = 0
End If
Next
Xi2(l) = Xi_on
Can2(l) = Can_on
l = l + 1
End If
Next
For i = 0 To l
Canshu = Can2(i)
XiShu = Xi2(i)
If Canshu > 1 Then
If Xishu = 1 Then
Res = Res & "+√" & Canshu
Else
Res = Res & "+" & Xishu & "√" & Canshu
End If
Else
Res = Res & "+" & Xishu
End If
Next
If Mid(Res, 1, 1) = "+" Then Res = Mid(Res, 2, Len(Res) - 1)
w = 1
w2 = 1
fds = 0
While InStr(w + 1, Res, "√") <> 0
w = InStr(w, Res, "√") + 1
shx = shx & string(w - w2, " ")
w2 = InStr(w, Res, "+")
shx = shx & string(w2 - w + 1, "_")
'fds = fds + 1
Wend
If Mid(Res, Len(Res), 1) = "+" Then Res = Mid(Res, 1, Len(Res) - 1)
Simplify = shx & vbCrLf & Res
End Function
