'修正程序，细化公式的一种程序代码：
Private Sub Command1_Click()
Dim m, n
m = Trim(Text1)
n = Trim(Text2)
b16 = "9908764683879298"
q = zhengchuqy(MCC1(Trim(m), Trim(n)))
q = q & String(10, "0")
B1 = zhengchuqy(MCC1(MPC(Trim(q), 1 & String(10, "0")), MPC(Trim(n), 1)))
b2 = zhengchuqy(MCC1(MPC(Trim(B1), 1 & String(10, "0")), 2))
b3 = MbC(Trim(b2), Trim(b16))
b4 = Mid(b3, 1, Len(b3) - 16)
b5 = MPC1(1 & String(10, "0"), MbC(Trim(b4), 2))
m1 = m & String(10, "0")
b10 = zhengchuqy(MCC1(Trim(m1), Trim(b5)))
n2 = zhengchuqy(MBBC(Trim(b10)))
Text3 = n2
End Sub
Private Function zhengchuqyushu(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqyushu = 0
Else
zhengchuqyushu = Mid(sa, InStr(sa, "/") + 1)
End If
End Function
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub
Public Function jie4cifc(a2 As String, b2 As String, c2 As String, d2 As String, e2 As String, sd As String) As String '4次方程
Dim a, b, c, d, f, g
Dim ja, jb, jc
k = DeleteSpace(a2)
ja = DeleteSpace(b2)
jb = DeleteSpace(c2)
jc = DeleteSpace(d2)
jd = DeleteSpace(e2)
sd1 = DeleteSpace(sd)
If Abs(Val(sd1)) <= 10 Then
sd = 10 + 2
Else
If Len(sd1) > 3 And Abs(Val(sd1)) > 300 Then
sd = 300 + 2
Else
sd = Int(Abs(Val(sd1))) + 2
End If
End If
a2 = zhengliys2(Trim(ja), Val(sd))
b2 = zhengliys2(Trim(jb), Val(sd))
c2 = zhengliys2(Trim(jc), Val(sd))
d2 = zhengliys2(Trim(jd), Val(sd))
k2 = zhengliys2(Trim(k), Val(sd))
If MBJC(Trim(k2), 0) = 0 Then
jie4cifc = "a 不能为 0"
jie4cifc = "a 为 0可能已不是1元4次方程"
Else
a3 = mcc2(Trim(a2), Trim(k2), Val(sd))
b3 = mcc2(Trim(b2), Trim(k2), Val(sd))
c3 = mcc2(Trim(c2), Trim(k2), Val(sd))
d3 = mcc2(Trim(d2), Trim(k2), Val(sd))
jk = 8 & String(sd, "0")
ja1 = mbc2("-4" & String(sd, "0"), Trim(b3), Val(sd))
jb1 = mpc2(mbc2(2 & String(sd, "0"), mbc2(Trim(a3), Trim(c3), Val(sd)), Val(sd)), mbc2(8 & String(sd, "0"), Trim(d3), Val(sd)))
jc1 = mpc2(mbc2(Trim(d3), mpc2(mbc2(4 & String(sd, "0"), Trim(b3), Val(sd)), mbc2(Trim(a3), Trim(a3), Val(sd))), Val(sd)), mbc2(Trim(c3), Trim(c3), Val(sd)))
y = jie3cifc(Trim(ja1), Trim(jb1), Trim(jc1), Trim(jk), Val(sd))
Y1 = zhengliys2(Trim(y), Val(sd))
End If
za = 1 & String(sd, "0")
z2 = mpc2(mpc3(mbc2(8 & String(sd, "0"), Trim(Y1), Val(sd)), mbc2(Trim(a3), Trim(a3), Val(sd))), mbc2(4 & String(sd, "0"), Trim(b3), Val(sd)))
z2 = mbbc2(qdfh(Trim(z2)), Val(sd))
zb1 = mcc2(mpc3(Trim(a3), Trim(z2)), 2 & String(sd, "0"), Val(sd))
zb2 = mcc2(mpc2(Trim(a3), Trim(z2)), 2 & String(sd, "0"), Val(sd))
zc1 = mpc3(Trim(Y1), mcc2(mpc2(mbc2(Trim(a3), Trim(Y1), Val(sd)), Trim(c3)), Trim(z2), Val(sd)))
zc2 = mpc2(Trim(Y1), mcc2(mpc2(mbc2(Trim(a3), Trim(Y1), Val(sd)), Trim(c3)), Trim(z2), Val(sd)))
y3 = jie2cifc(Trim(za), Trim(zb1), Trim(zc1), Val(sd))
y4 = jie2cifc(Trim(za), Trim(zb2), Trim(zc2), Val(sd))
jie4cifc = y3 & "/" & y4
End Function
Public Function jie2cifc(a2 As String, b2 As String, c2 As String, sd As String) As String '2次方程
Dim d, y
d = mbc2(Trim(b2), Trim(b2), Val(sd))
D1 = mpc2(Trim(d), mbc2(4 & String(sd, "0"), mbc2(Trim(a2), Trim(c2), Val(sd)), Val(sd)))
d3 = qdfh(Trim(D1))
d2 = mbbc2(Trim(d3), Val(sd))
y = mcc2(Trim(b2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
sf = fhys(Trim(y))
sf = Val(-1 * sf)
y = tjfh(qdfh(Trim(y)), Val(sf))
y = shuchujg(Trim(y), Val(sd))
y = qdxsd(Trim(y))
If mbjc2(Trim(D1), 0) >= 0 Then
d3 = mcc2(Trim(d2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
d3 = shuchujg(Trim(d3), Val(sd))
d3 = qdxsd(Trim(d3))
Else
d3 = mcc2(Trim(d2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
d3 = shuchujg(Trim(d3), Val(sd))
d3 = qdxsd(Trim(d3))
d3 = d3 & "i"
End If
If InStr(d3, "i") = 0 Then
jie2cifc = mpc3(Trim(y), Trim(d3)) & "/" & mpc2(Trim(y), Trim(d3))
Else
jie2cifc = y & "+" & d3 & "/" & y & "-" & d3
End If
End Function
Private Function max(ByVal lists As String) As String
Dim temp As String
Dim a() As String
a = Split(lists, "/")
Dim b As Long
temp = a(0)
For b = 0 To UBound(a)
If MBJC(qdfh(temp), qdfh(a(b))) < 0 Then temp = a(b)
Next
max = temp
End Function
Private Function zhengchuqyushu(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqyushu = 0
Else
zhengchuqyushu = Mid(sa, InStr(sa, "/") + 1)
End If
End Function
Private Function xhq4xs(sa As String, sb As String) As String
Dim m, p, b, c, d
m = DeleteSpace(Trim(sa))
p = DeleteSpace(Trim(sb))
jd = zhengchuqy(MCC1(Trim(m), 4))
sd = 22
a2 = zhengliys2(Trim(m), Val(sd))
b2 = zhengliys2(Trim(p), Val(sd))
q = mcc2(Trim(a2), Trim(b2), Val(sd))
q1 = zhengliys2(1, Val(sd))
q2 = MPC(Trim(q), Trim(q1))
p2 = MPC(Trim(b2), Trim(q1))
a = mcc2(Trim(q2), Trim(p2), Val(sd))
n = MCC1(MPC(Trim(p), 1), 2)
n1 = MPC1(MbC(Trim(n), 2), 1)
n2 = MPC1(MbC(Trim(n), 4), 1)
n = zhengliys2(Trim(n), Val(sd))
n1 = zhengliys2(Trim(n1), Val(sd))
n2 = zhengliys2(Trim(n2), Val(sd))
b = MPC1(mbc2(mbc2(Trim(n), Trim(a), Val(sd)), 2 & String(Val(sd), "0"), Val(sd)), mbc2(Trim(n2), Trim(a), Val(sd)))
c = MPC1(mbc2(mbc2(Trim(n), 2 & String(Val(sd), "0"), Val(sd)), mbc2(Trim(n2), Trim(a), Val(sd)), Val(sd)), mbc2(mbc2(Trim(n), Trim(n1), Val(sd)), Trim(a), Val(sd)))
c = mpc2(Trim(c), mbc2(mbc2(Trim(n), Trim(n), Val(sd)), Trim(a), Val(sd)))
n3 = mbc2(Trim(n), Trim(n), Val(sd))
n4 = mbc2(Trim(n3), Trim(n), Val(sd))
d = mpc2(mbc2(mbc2(Trim(n3), 2 & String(Val(sd), "0"), Val(sd)), mbc2(Trim(n1), Trim(a), Val(sd)), Val(sd)), mbc2(mbc2(Trim(n3), Trim(n2), Val(sd)), Trim(a), Val(sd)))
e = mpc2(mbc2(mbc2(Trim(jd), Trim(n3), Val(sd)), 2 & String(Val(sd), "0"), Val(sd)), mbc2(mbc2(Trim(n1), Trim(a), Val(sd)), Trim(n4), Val(sd)))
a1 = shuchujg(Trim(a), Val(sd))
B1 = shuchujg(Trim(b), Val(sd))
C1 = shuchujg(Trim(c), Val(sd))
D1 = shuchujg(Trim(d), Val(sd))
e1 = shuchujg(Trim(e), Val(sd))
xhq4xs = a1 & "/" & B1 & "/" & C1 & "/" & D1 & "/" & e1
End Function
Private Function xhgs2(sa As String, sb As String) As String
Dim m, p, a, b, c
m = Trim(sa)
p = Trim(sb)
Do While s <= 10
q = zhengchuqy(MCC1(Trim(m), Trim(p)))
r = zhengchuqyushu(MCC1(Trim(m), Trim(p)))
a = MPC(Trim(q), zhengchuqy(MCC(Trim(r), 90)))
p1 = zhengchuqy(MCC1(Trim(m), Trim(a)))
s1 = s1 & p1 & vbCrLf
p = p1
s = s + 1
Loop
xhgs2 = s1
End Function
Private Function xhgs(sa As String, sb As String) As String
Dim m, n
m = Trim(sa)
n = Trim(sb)
b16 = "9908764683879298"
q = zhengchuqy(MCC1(Trim(m), Trim(n)))
q = q & String(10, "0")
B1 = zhengchuqy(MCC1(MPC(Trim(q), 1 & String(10, "0")), MPC(Trim(n), 1)))
b2 = zhengchuqy(MCC1(MPC(Trim(B1), 1 & String(10, "0")), 2))
b3 = MbC(Trim(b2), Trim(b16))
b4 = Mid(b3, 1, Len(b3) - 16)
b5 = MPC1(1 & String(10, "0"), MbC(Trim(b4), 2))
m1 = m & String(10, "0")
b10 = zhengchuqy(MCC1(Trim(m1), Trim(b5)))
n2 = zhengchuqy(MBBC(Trim(b10)))
xhgs = n2
End Function
Private Function qdxsd(sa As String) As String
If InStr(sa, ".") = 0 Then
qdxsd = sa
Else
qdxsd = Mid(sa, 1, InStr(sa, ".") - 1)
End If
End Function
Private Function xhgs2(sa As String, sb As String) As String
Dim m, p, a, b, c
m = Trim(sa)
p = Trim(sb)
Do While s <= 20
q = zhengchuqy(MCC1(Trim(m), Trim(p)))
r = zhengchuqyushu(MCC1(Trim(m), Trim(p)))
a = MPC(Trim(q), zhengchuqy(MCC(Trim(r), 35)))
p1 = zhengchuqy(MCC1(Trim(m), Trim(a)))
s1 = s1 & "/" & p1
p = p1
s = s + 1
Loop
xhgs2 = s1
End Function
本帖最后由 ysr 于 2023-12-12 14:27 编辑
Private Sub Command1_Click()
Dim n, i, s
n = Trim(Text1)
s = Trim(Text2)
i = MbC(Trim(s), 3)
Do While MBJC(Trim(s), zhengchuqyushu(MCC1(Trim(n), Trim(i)))) < 0 And MBJC(zzxc(Trim(n), Trim(i)), 1) = 0
r = zhengchuqyushu(MCC1(Trim(n), Trim(i)))
i = r
Loop
If MBJC(zzxc(Trim(n), Trim(i)), 1) = 0 Then
Text3 = "wujie"
Else
p = zzxc(Trim(n), Trim(i))
Text3 = p
End If
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub
本帖最后由 ysr 于 2023-12-16 02:30 编辑
Private Sub Command1_Click()
Dim n, i, s
n = Trim(Text1)
s = Trim(Text2)
i = MbC(Trim(s), 3)
n2 = n
Do While s1 < 100
s1 = s1 + 1
Do While MBJC(Trim(s), zhengchuqyushu(MCC1(Trim(n), Trim(i)))) < 0 And MBJC(zzxc(Trim(n), Trim(i)), 1) = 0
r = zhengchuqyushu(MCC1(Trim(n), Trim(i)))
n = i
i = r
Loop
If MBJC(zzxc(Trim(n), Trim(i)), 1) = 0 Then
s3 = "wujie"
Else
s2 = s2 + 1
p = zzxc(Trim(n), Trim(i))
s4 = MCC(MPC1(Trim(n), 1), 3)
End If
n = n
i = i - 1
Loop
If s2 > 1 Then
Text3 = s4
Else
Text3 = s3
End If
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub
Private Sub Command1_Click()
Dim n, i, s
n = Trim(Text1)
s = Trim(Text2)
i = MbC(Trim(s), 3)
n2 = n
i2 = i
Do While s1 < 400
s1 = s1 + 1
Do While MBJC(Trim(s), zhengchuqyushu(MCC1(Trim(n), Trim(i)))) < 0 And MBJC(zzxc(Trim(n), Trim(i)), 1) = 0
r = zhengchuqyushu(MCC1(Trim(n), Trim(i)))
n = i
i = r
Loop
If MBJC(zzxc(Trim(n), Trim(i)), 1) = 0 Then
s3 = "wujie"
Else
s2 = s2 + 1
p = zzxc(Trim(n), Trim(i))
s4 = s4 & "" & MCC(MPC1(Trim(i), 1), 3)
End If
n = n2
i2 = i2 - 1
i = i2
Loop
If s2 > 0 Then
Text3 = s4
Else
Text3 = s3
End If
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub
Private Sub Command1_Click()
Dim n, i, s
n = Trim(Text1)
s = Trim(Text2)
i = MbC(Trim(s), 2)
n2 = n
i2 = i
Do While s1 < 300
s1 = s1 + 1
Do While MBJC(Trim(s), zhengchuqyushu(MCC1(Trim(n), Trim(i)))) < 0 And MBJC(zzxc(Trim(n), Trim(i)), 1) = 0
r = zhengchuqyushu(MCC1(Trim(n), Trim(i)))
i = r
Loop
If MBJC(zzxc(Trim(n), Trim(i)), 1) = 0 Then
s3 = "wujie"
Else
s2 = s2 + 1
p = zzxc(Trim(n), Trim(i))
s4 = p
's4 = s4 & "" & MCC(MPC1(Trim(i), 1), 2)
End If
n = n2
i2 = i2 - 1
i = i2
Loop
If s2 > 0 Then
Text3 = s4
Else
Text3 = s3
End If
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub