本人用到的可调用程序总汇

ysr · 发表于 2026-4-17 07:45

本帖最后由 ysr 于 2026-4-22 23:37 编辑

Private Function qdqiandao0(sa As String) As String
'去掉前导0的程序
Do While Left(sa, 1) = "0"
sa = Mid(sa, 2)
Loop
If Len(sa) = 0 Then
qdqiandao0 = 0
Else
qdqiandao0 = sa
End If
End Function

Private Function jsmssushu(sa As String) As String
'计算梅森数的程序
Dim B
B = 1
Do While c <= sa - 1
B = MbC(Trim(B), 2)
c = c + 1
Loop
jsmssushu = MPC(Trim(B), 1)
End Function

Private Function fenjieyinzi2(a As String) As String
'判断素数及分解合数的程序（数值稍大的如10位以上的也可以）
x = 3
Do While InStr(MCC(Trim(a), 2), "/") = 0 And MBJC(Trim(a), 4) >= 0


If B = 0 Then
fenjieyinzi2 = fenjieyinzi2 & "2"
B = 1
Else
fenjieyinzi2 = fenjieyinzi2 & "*2"
End If
a = MCC(Trim(a), 2)
k = a

Loop

Do While MBJC(Trim(a), "0001") > 0
Do While MBJC(Trim(x), zhengchuqy(MBBC(Trim(a)))) <= 0
Do While InStr(MCC1(Trim(a), Trim(x)), "/") = 0 And MBJC(Trim(a), MbC(Trim(x), Trim(x))) >= 0

If B = 0 Then
fenjieyinzi2 = fenjieyinzi2 & x
B = 1
Else
fenjieyinzi2 = fenjieyinzi2 & "*" & x
End If
a = MCC1(Trim(a), Trim(x))
Loop

x = MPC1(Trim(x), 2)
Loop

k = a
a = 1
Loop

If B = 1 Then
fenjieyinzi2 = fenjieyinzi2 & "*" & k
Else
fenjieyinzi2 = "这是一个质数"
End If
End Function

Private Function fenjieyinzi1(sa As String) As String
'判断素数及分解合数的程序（小数值的）
Dim x, a, B, k As String
a = Val(sa)

x = 3
If a <= 1 Or a > Int(a) Then
If a = 1 Then
fenjieyinzi1 = "它既不是质数，也不是合数"

Else
MsgBox "error"
End If

Else

Do While a / 2 = Int(a / 2) And a >= 4

If B = 0 Then
fenjieyinzi1 = fenjieyinzi1 & "2"
B = 1
Else
fenjieyinzi1 = fenjieyinzi1 & "*2"
End If
a = a / 2
k = a

Loop

Do While a > 1
Do While x <= Sqr(a)
Do While a / x = Int(a / x) And a >= x * x

If B = 0 Then
fenjieyinzi1 = fenjieyinzi1 & x
B = 1
Else
fenjieyinzi1 = fenjieyinzi1 & "*" & x
End If
a = a / x
Loop

x = x + 2
Loop

k = a
a = 1
Loop

If B = 1 Then
fenjieyinzi1 = fenjieyinzi1 & "*" & k
Else
fenjieyinzi1 = "这是一个质数"
End If





End If

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

Public Function jie3cifc(a2 As String, b2 As String, c2 As String, k2 As String, sd As String) As String '3次方程
'解3次方程的程序，必须输入移动小数点后的数据，还要输入需要精确的位数，就是移动小数点的位数
'用鲍丰武的方法解方程
'a为2次项的系数，k为3次项的系数，注意a和k的输入顺序和位置，输出最大的一个实数解
a3 = mcc2(Trim(a2), Trim(k2), Val(sd))
b3 = mcc2(Trim(b2), Trim(k2), Val(sd))
c3 = mcc2(Trim(c2), Trim(k2), Val(sd))

' m = 36 * Val(ja) * Val(jb) - 8 * Val(ja) ^ 3 - 108 * Val(jc)
If mbjc2(Trim(a3), 0) = 0 And mbjc2(Trim(b3), 0) = 0 Then
m = mbc2(-108 & String(sd, "0"), Trim(c3), Val(sd))

n4 = qdfh(mbc2(Trim(m), Trim(m), Val(sd)))
Else

m1 = mbc2(mbc2(Trim(a3), Trim(b3), Trim(sd)), Val(36) & String(sd, "0"), Val(sd))
m2 = mbc2(mbc2(mbc2(Trim(a3), Trim(a3), Trim(sd)), Trim(a3), Val(sd)), Val(8) & String(sd, "0"), Val(sd))
m3 = mbc2(Trim(c3), Val(108) & String(sd, "0"), Val(sd))
m = mpc2(mpc2(Trim(m1), Trim(m2)), Trim(m3))
  Print "m="; m

'n1 = Val(m) ^ 2 + (12 * Val(B) - 4 * Val(A) ^ 2) ^ 3

  n1 = mbc2(Trim(m), Trim(m), Val(sd))
n2 = mpc2(mbc2(Trim(b3), Val(12) & String(sd, "0"), Val(sd)), mbc2(mbc2(Trim(a3), Trim(a3), Val(sd)), Val(4) & String(sd, "0"), Val(sd)))
   n3 = mbc2(mbc2(Trim(n2), Trim(n2), Val(sd)), Trim(n2), Val(sd))
   n4 = mpc3(Trim(n1), Trim(n3))
   End If
   fn4 = fhys(Trim(n4))
n5 = mbbc2(qqdl(qdfh(Trim(n4))), Val(sd))
Print "n5="; n5

'If n1 < 0 And m < 0 Then
If Val(fn4) < 0 And Val(fhys(Trim(m))) < 0 Then
'n=(93312R^6+311040R^5+285120R^4+221824R^3+27020R^2+3712R+320)^(1/2)
'a=-(2+81k)
'm=216r^3+360r^2+128r-8
'k=(n^2/m^2)/27
''a1=(M/8*(9t-1))^(1/3),,b1=a1*(t)^(1/2)
'令m=19683N^6+1215N^4M^2+17N^2M^4-M^6,
'm1=243N^4+3N^2M^2+M^4,
'n=(m^2-m1^3)^(1/2),
'则:t=(((m+n)^(1/3)+(m-n)^(1/3))+(2*M^2+3*N^2))/(3*M^2),
''其中M≠m，N≠n，
jq = mbbc3(mbbc2(qqdl(MPC1(mbc2(qdfh(Trim(m)), qdfh(Trim(m)), Val(sd)), mbc2(qdfh(Trim(n5)), qdfh(Trim(n5)), Val(sd)))), Val(sd)), Val(sd))
jq3 = mcc2(Trim(n5), Trim(m), Val(sd))
jq1 = jsfanzq(mcc2(Trim(n5), Trim(m), Val(sd)), Val(sd))
Print "jq3="; jq3
Print "jq1="; jq1
q1 = mbc2(Trim(jq), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), Val(sd))

Print "q1="; q1

If Val(fhys(Trim(q1))) > 0 Then
  q = tjfh(Trim(q1), Val(-1))
  Else
  q = qdfh(Trim(q1))
  End If
jq3 = mbbc2(MPC(1 & String(sd, "0"), mbc2(jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), _
Val(sd))), Val(sd))
jq2 = tjfh(Trim(jq3), Val(-1))
Print "jq2="; jq2

qa = mbc2(Trim(jq), Trim(jq2), Val(sd))
p = q
pa = qa
  Else
  'If n1 < 0 And m > 0 Then
If Val(fn4) < 0 And MBJC(qdfh(Trim(m)), 0) > 0 Then

jq = mbbc3(mbbc2(qqdl(MPC1(mbc2(qdfh(Trim(m)), qdfh(Trim(m)), Val(sd)), mbc2(qdfh(Trim(n5)), qdfh(Trim(n5)), Val(sd)))), Val(sd)), Val(sd))
jq1 = jsfanzq(mcc2(Trim(n5), Trim(m), Val(sd)), Val(sd))
jq3 = mcc2(Trim(n5), Trim(m), Val(sd))
q = mbc2(Trim(jq), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), Val(sd))
jq2 = mbbc2(MPC(1 & String(sd, "0"), mbc2(jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), _
Val(sd))), Val(sd))
Print "jq3="; jq3
Print "jq1="; jq1
Print "q"; q
Print "jq2="; jq2
qa = mbc2(Trim(jq), Trim(jq2), Val(sd))
p = q
pa = qa
Else
'If Val(m) + Val(n2) < 0 Then
If fhys(mpc3(Trim(m), Trim(n5))) = -1 Then
p = "-" & mbbc3(qdfh(mpc3(Trim(m), Trim(n5))), Val(sd))
Else
p = mbbc3(mpc3(Trim(m), Trim(n5)), Val(sd))

End If

'If Val(m) < Val(n2) Then
If mbjc2(Trim(m), Trim(n5)) = -1 Then
'q = -(Val(n2) - Val(m)) ^ (1 / 3)
q = "-" & mbbc3(qdfh(mpc2(Trim(n5), Trim(m))), Val(sd))
Else
q = mbbc3(mpc2(Trim(m), Trim(n5)), Val(sd))

End If

  End If


  End If

  'If a = 0 And b = 0 Then
  If Val(fn4) > 0 And mbjc2(Trim(n4), 0) <> 0 Then  'Val(n4) > 0 Or mbjc2(Trim(n4), 0) = 0
  tx1 = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  ftx1 = fhys(Trim(tx1))
  tx4 = mcc2(mpc3(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 4 & String(sd, "0"), Val(sd))), 12 & String(sd, "0"), Val(sd))
  If Val(fhys(Trim(tx4))) > 0 Then
  tx2 = tjfh(Trim(tx4), Val(-1))
  Else
  tx2 = qdfh(Trim(tx4))
  End If
  ' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i数据太大有误差"
' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i可选大数据高精度的"
tx3 = zhengchuqy(MCC1(qdfh(mbc2(mpc2(Trim(p), Trim(q)), zhengchuqy(MBBC(3 & String(2 * Val(sd), "0"))), Val(sd))), 12))
jie3cifc = shuchujg(Trim(tx1), Val(sd))

  Else
  If Mid(fn4, 1, 1) = "-" And Trim(m) = 0 Or Trim(n5) = 0 Then
tx1 = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  ftx1 = fhys(Trim(tx1))
  tx4 = mcc2(mpc3(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 4 & String(sd, "0"), Val(sd))), 12 & String(sd, "0"), Val(sd))
  ' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i数据太大有误差"
' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i可选大数据高精度的"
tx3 = mcc2(mbc2(mpc2(Trim(p), Trim(q)), zhengchuqy(MBBC(3 & String(2 * Val(sd), "0"))), Val(sd)), 12 & String(sd, "0"), Val(sd))
  If Val(fhys(Trim(tx4))) > 0 Then
  tx2 = tjfh(Trim(tx4), Val(-1))
  Else
  tx2 = qdfh(Trim(tx4))
  End If
  tx1 = shuchujg(Trim(tx1), Val(sd))
tx12 = shuchujg(mpc3(Trim(tx2), Trim(tx3)), Val(sd))
  tx13 = shuchujg(mpc2(Trim(tx2), Trim(tx3)), Val(sd))
  tx14 = tx1 & "/" & tx12 & "/" & tx13
  jie3cifc = max(Trim(tx14))

  Else

  'd = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  'd = mcc2(MPC(qdfh(mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), mpc3(Trim(p), Trim(q))), 6 & String(sd, "0"), Val(sd))
  'mpc2减法器有问题？
  'fd = fhys(Trim(d))
  tx1 = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  ftx1 = fhys(Trim(tx1))
  tx4 = mcc2(mpc3(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 4 & String(sd, "0"), Val(sd))), 12 & String(sd, "0"), Val(sd))
  ' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i数据太大有误差"
' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i可选大数据高精度的"
tx3 = mcc2(mbc2(mpc3(Trim(pa), Trim(qa)), zhengchuqy(MBBC(3 & String(2 * Val(sd), "0"))), Val(sd)), 12 & String(sd, "0"), Val(sd))
If Val(fhys(Trim(tx4))) > 0 Then
  tx2 = tjfh(Trim(tx4), Val(-1))
  Else
  tx2 = qdfh(Trim(tx4))
  End If
  tx1 = shuchujg(Trim(tx1), Val(sd))
tx12 = shuchujg(mpc3(Trim(tx2), Trim(tx3)), Val(sd))
  tx13 = shuchujg(mpc2(Trim(tx2), Trim(tx3)), Val(sd))
  tx14 = tx1 & "/" & tx12 & "/" & tx13
  jie3cifc = max(Trim(tx14))

  End If

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 qdfh(temp) < qdfh(a(B)) Then temp = a(B)
Next
max = temp
End Function

Public Function jie2cifc(a2 As String, b2 As String, c2 As String, sd As String) As String '2次方程
'解2次方程的程序，必须输入移动小数点后的数据，还要输入需要精确的位数，就是移动小数点的位数
Dim d, y
b3 = b2
b2 = qdfh(b2)
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(b3))
sf = Val(-1 * sf)
y = tjfh(qdfh(Trim(y)), Val(sf))
If mbjc2(Trim(D1), 0) >= 0 Then
d3 = mcc2(Trim(d2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
Y1 = mpc3(Trim(y), Trim(d3))
Y2 = mpc2(Trim(y), Trim(d3))
y = shuchujg(Trim(Y1), Val(sd))
d3 = shuchujg(Trim(Y2), Val(sd))
jie2cifc = y & ", " & d3
Else
y = shuchujg(Trim(y), Val(sd))
d3 = mcc2(Trim(d2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
d3 = shuchujg(Trim(d3), Val(sd)) & "i"
jie2cifc = y & "+ -" & d3
End If

End Function

Private Function jspaizh(sd As String) As String '派/2=1+1/3+1*2/3*5+1*2*3/3*5*7+……
'应该是 Pi/4=1-1/3+1/5-1/7+…+（-1）^(n-1)/(2*n-1)吧，呵呵
'派/2=2/1*2/3*4/3*4/5^^^^^=2*2/1*3*4*4/3*5*6*6/5*7*^^^^^^^
'取高精度派值的程序，需要输入精确到点后的位数
Dim s1 As String
s1 = "31415926535 8979323846 2643383279 5028841971 6939937510 5820974944 5923078164 0628620899 8628034825 3421170679 8214808651 32823066470938446095 5058223172 5359408128 4811174502 8410270193 8521105559 6446229489 5493038196 4428810975 6659334461 2847564823 37867831652712019091 4564856692 3460348610 4543266482 1339360726 0249141273 7245870066 0631558817 4881520920 9628292540 9171536436 7892590360" _
& "0113305305 4882046652 1384146951 9415116094 3305727036 5759591953 0921861173 8193261179 3105118548 0744623799 6274956735 1885752724" _
& "8912279381 8301194912 9833673362 4406566430 8602139494 6395224737 1907021798 6094370277 0539217176 2931767523 8467481846 7669405132" _
& "0005681271 4526356082 7785771342 7577896091 7363717872 1468440901 2249534301 4654958537 1050792279 6892589235 4201995611 2129021960" _
& "8640344181 5981362977 4771309960 5187072113 4999999837 2978049951 0597317328 1609631859 5024459455 3469083026 4252230825 3344685035"
s2 = DeleteSpace(s1)
jspaizh = zhengchuqy(MCC1(Left(s2, Val(sd) + 1), Val(2)))

End Function
Private Function zhengliys3(sa As String, sd As String) As String
'整理和移动小数点的程序，同时提取前面的符号并调价再输出结果前面
fa1 = fhys(Trim(sa))
If Trim(sa) = 0 Then
zhengliys3 = 0
Else

a2 = qqdl(ydxsd(qdfh(Trim(sa)), Val(sd)))
zhengliys3 = tjfh(Trim(a2), Trim(fa1))
End If

End Function

Private Function zhengliys2(sa As String, sd As String) As String
'整理和提取特殊符号如"√"和"("等其中的数值并适当计算
  If sa = "" Or sa = "Text1" Or sa = "Text2" Or sa = "Text3" Or sa = "Text7" Then
  zhengliys2 = 0
Else

  If Len(sa) <= 2 And InStr(sa, "√") = 0 Then
zhengliys2 = zhengliys3(Trim(sa), Val(sd))
Else

If InStr(sa, "(") = 0 Then
a1 = 1
B1 = 1
sa1 = sa
Else
  If InStr(sa, "(") = 1 Then
a1 = 1
sa1 = Mid(sa, InStr(sa, "(") + 1, InStr(sa, ")") - 2)
B1 = Mid(sa, InStr(sa, ")") + 2)
Else

a1 = Left(sa, InStr(sa, "(") - 1)
B1 = Mid(sa, InStr(sa, ")") + 2)
sa1 = Mid(sa, InStr(sa, "(") + 1, InStr(sa, ")") - 2 - Val(Len(a1)))
End If
End If
If a1 = "+" Then
a1 = 1
Else
If a1 = "-" Then
a1 = -1
Else
a1 = a1
End If
End If

If B1 = "" Or Val(B1) = 0 Then
B1 = 1
Else
B1 = B1
End If

'If Val(Len(Mid(sa, InStr(sa, ")")))) = 1 Or Val(Len(Mid(sa, InStr(sa, ")")))) = 2 Then
'b1 = 1

If InStr(sa1, "+") = 0 And InStr(sa1, "-") = 0 Then
sa2 = zhengliys(Trim(sa1), Val(sd))

Else
If InStr(sa1, "+") = 1 Or InStr(sa1, "-") = 1 Then
sa3 = Mid(sa1, 2)
Else
sa3 = sa1
End If

Do While InStr(sa3, "+") > 0 Or InStr(sa3, "-") > 0

If InStr(sa3, "+") < InStr(sa3, "-") And InStr(sa3, "+") >= 1 Then
   If sa3 = sa1 Then
   sa4 = Left(sa1, InStr(sa3, "+") - 1)
   Else

sa4 = Left(sa1, InStr(sa3, "+"))
End If
sa1 = Mid(sa3, InStr(sa3, "+"))
Else
If InStr(sa3, "-") < InStr(sa3, "+") And InStr(sa3, "-") >= 1 Then
sa4 = Left(sa1, InStr(sa3, "-"))
sa1 = Mid(sa3, InStr(sa3, "-"))
Else
If InStr(sa3, "-") = 0 And InStr(sa3, "+") > 0 Then
sa4 = Left(sa1, InStr(sa3, "+"))
'sa1 = Mid(sa3, InStr(sa3, "+") + Val(Len(a1)) - Val(Len(a3)))
sa1 = Mid(sa3, InStr(sa3, "+"))
Else
If InStr(sa3, "-") > 0 And InStr(sa3, "+") = 0 Then
sa4 = Left(sa1, InStr(sa3, "-"))
sa1 = Mid(sa3, InStr(sa3, "-"))
End If
End If
End If
End If
sa2 = mpc3(zhengliys(Trim(sa4), Val(sd)), Trim(sa2))
If InStr(sa1, "+") = 1 Or InStr(sa1, "-") = 1 Then
sa3 = Mid(sa1, 2)
Else
sa3 = sa1
End If
sa1 = sa1
Print sa4

Loop
Print sa1
  sa2 = mpc3(Trim(sa2), zhengliys(Trim(sa1), Val(sd)))
  Print sa2
  End If
zhengliys2 = mcc2(mbc2(zhengliys(Trim(a1), Val(sd)), Trim(sa2), Val(sd)), zhengliys(Trim(B1), Val(sd)), Val(sd))

End If
End If
End Function

Private Function zhengliys(sa As String, sd As String) As String
'整理和提取"√"，"/"和正负好并计算
js = Right(sa, 1)
If js = "+" Or js = "-" Then
sa = Mid(sa, 1, Len(sa) - 1)
Else
sa = sa
End If

If InStr(sa, "/") = 0 Then
B1 = 1
a2 = sa
  Else
B1 = Mid(sa, InStr(sa, "/") + 1)
a2 = Left(sa, InStr(sa, "/") - 1)
End If
If B1 = "" Or Val(B1) = 0 Then
B1 = 1
Else
B1 = B1
End If

If InStr(a2, "√") = 0 Then
C1 = a2
a1 = 1
Else
If InStr(a2, "√") = 1 Then
  C1 = 1
  a1 = Mid(a2, InStr(a2, "√") + 1)
Else
C1 = Left(a2, InStr(a2, "√") - 1)
If Len(C1) = 1 And InStr(C1, "-") = 1 Then
C1 = -1
Else
If Len(C1) = 1 And InStr(C1, "+") = 1 Then
C1 = 1
Else
C1 = C1
End If
End If

a1 = Mid(a2, InStr(a2, "√") + 1)
  End If
  End If
  a1 = zhengliys3(Trim(a1), Val(sd))


  B1 = zhengliys3(Trim(B1), Val(sd))
  C1 = zhengliys3(Trim(C1), Val(sd))


  zhengliys = mcc2(mbc2(mbbc2(Trim(a1), Val(sd)), Trim(C1), Val(sd)), Trim(B1), Val(sd))

End Function

Private Function jsfanzq(sa As String, sd As String) As String
'计算反正切的程序
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 0 Then
jsfanzq = zhengchuqy(MCC1(jspaizh(sd), Val(2)))
Else
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
sa1 = zhengchuqy(MCC1(1 & String(2 * Val(sd), "0"), qdfh(Trim(sa))))
Else
sa1 = qdfh(Trim(sa))
End If

Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa1), Trim(sa1), Val(sd))
fs1 = -1
s3 = 3
Do While MBJC(zhengchuqy(MCC1(Trim(s1), Val(s3))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), Val(s3))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)

Loop

js4 = mbc2(Trim(sa1), mpc3(Val(1) & String(Val(sd), "0"), Trim(s)), Val(sd))
fsa = fhys(Trim(sa))
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
jsfanzq = tjfh(mpc2(jspaizh(sd), Trim(js4)), Val(fsa))
Else
  jsfanzq = tjfh(Trim(js4), Val(fsa))
  End If
End If
End Function

Private Function jsyuxian(sa As String, sd As String) As String
'计算余弦的程序
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
jsyuxian = jszhxian(MPC(jspaizh(Val(sd)), qdfh(Trim(sa))), Val(sd))
Else
Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa), Trim(sa), Val(sd))
fs1 = -1
s3 = 2
Do While MBJC(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)

Loop

jsyuxian = mpc3(Val(1) & String(Val(sd), "0"), Trim(s))
End If
End Function

ysr · 发表于 2026-4-17 07:45

Private Function jszhxian(sa As String, sd As String) As String
'计算正弦的程序
Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa), Trim(sa), Val(sd))
fs1 = -1
s3 = 3
Do While MBJC(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)

Loop

jszhxian = mbc2(Trim(sa), mpc3(Val(1) & String(Val(sd), "0"), Trim(s)), Val(sd))
End Function

Private Function zhengchuqy(sa As String) As String
'取整除后的商或方根或立方跟的整数部分的程序
If InStr(sa, "/") = 0 Then
zhengchuqy = sa
Else
zhengchuqy = Left(sa, InStr(sa, "/") - 1)
End If

End Function

Private Function tjxsd(sa As String, sd As String) As String
'添加小数点的程序
If Val(Len(sa)) > Val(sd) Then
tjxsd = Left(sa, Val(Len(sa)) - Val(sd)) & "." & Mid(sa, Val(Len(sa)) - Val(sd) + 1)
Else
If Val(Len(sa)) = Val(sd) Then
  tjxsd = "0." & sa
  Else
  tjxsd = "0." & String(Val(sd) - Val(Len(sa)), "0") & Trim(sa)
  End If
  End If

End Function

Public Function MBBC(D1 As String) As String 'kai pingfang
'开平方的程序
If Len(D1) < 10 Then
jss = Int(Sqr(Val(D1)))
JW = Val(D1) - (jss) ^ 2
If JW = 0 Then
MBBC = jss
Else
MBBC = jss & "/" & JW
End If
Else
Dim x 'shuju changdu
x = Len(D1) \ 4
d2 = String(4 - Len(D1) + 4 * x, "0") & D1
Dim a() As String
ReDim a(4 To 4 * x + 4)
Dim B() As String
ReDim B(2 To 2 * x)
Dim i, j, js
For i = 4 To 4 * x + 4 Step 4

a(i) = Mid(d2, i - 3, 4)
js = Int(Sqr(Val(a(4) & a(8))))
JW = Val(a(4) & a(8)) - (js) ^ 2
Next
  j = 4
  Do While j <= 2 * x

  jws = MPC1(JW & "0000", a(2 * j + 4))
  If MBJC(Trim(jws), MbC(Trim(js), 200)) <= 0 Then
B(j) = "00"
Else
jwc = Left(jws, Len(jws) - Len(MbC(Trim(js), 200)) + 2) \ Left(MbC(Trim(js), 200), 2)
If Len(jwc) > 2 Then
B(j) = 99
Else
B(j) = jwc
End If


Do While MBJC(Trim(jws), MbC(MPC1(B(j), MbC(Trim(js), 200)), B(j))) = -1

B(j) = B(j) - 1

            Loop
      End If
      JW = MPC(Trim(jws), MbC(MPC1(MbC(200, Trim(js)), B(j)), B(j)))

js = MPC1(MbC(Trim(js), 100), Trim(B(j)))


  j = j + 2
  If JW = 0 Then

  MBBC = js
  Else
  MBBC = js & "/" & JW
  End If
  Loop

End If
End Function
Public Function MBJC(D1 As String, d2 As String) As String 'bijiao
'比较大小的程序
If Len(D1) > Len(d2) Then
MBJC = 1
Else
If Len(D1) < Len(d2) Then
MBJC = -1
Else
If Len(D1) = Len(d2) And Len(D1) >= 10 Then

Dim x, y
x = Len(D1) \ 4: y = Len(d2) \ 4
Dim a() As String, B() As String
ReDim a(4 To 4 * x + 4)
ReDim B(4 To 4 * y + 4)
If Val(Left(D1, Len(D1) - 4 * x)) > Val(Left(d2, Len(d2) - 4 * y)) Then
MBJC = 1
Else
If Val(Left(D1, Len(D1) - 4 * x)) < Val(Left(d2, Len(d2) - 4 * y)) Then
MBJC = -1
Else
For i = 4 To 4 * x Step 4
a(i) = Mid(D1, Len(D1) - i + 1, 4)
B(i) = Mid(d2, Len(d2) - i + 1, 4)
Next
j = 4 * x
Do While a(j) = B(j) And j >= 8

j = j - 4
Loop

  If Val(a(j)) - Val(B(j)) > 0 Then
  MBJC = 1
  Else
  If Val(a(j)) - Val(B(j)) < 0 Then
  MBJC = -1
  Else
  MBJC = 0
  End If

End If

End If
End If
End If
If Len(D1) < 10 Then
ja = Val(D1) - Val(d2)
  If ja > 0 Then
MBJC = 1
Else
If ja = 0 Then
   MBJC = 0
Else

  MBJC = -1
End If
End If
End If

End If
End If
End Function

Public Function MbC(D1 As String, d2 As String) As String
'乘法可调用程序
Dim j1&, j2&, e&, d&, e1&, m, n

' 按列法计算C=A*B
m = Trim(D1): n = Trim(d2)
x = Len(m) \ 4: y = Len(n) \ 4
m = String(4 * x + 4 - Len(m), "0") & m
n = String(4 * y + 4 - Len(n), "0") & n
x = x + 1: y = y + 1
Dim a(), B()
ReDim a(1 To x): ReDim B(1 To y)
For i1 = 1 To x
a(i1) = Val(Mid(m, i1 * 4 - 3, 4))
Next
For i2 = 1 To y
B(i2) = Val(Mid(n, i2 * 4 - 3, 4))
Next
ma = x: mb = y
MC = ma + mb
ReDim c(MC)
e1 = 0
j1 = ma: j2 = ma
For i = MC To 2 Step -1
      If i <= ma Then j2 = i - 1
      e = e1: e1 = 0
      For j = j1 To j2
         e = e + a(j) * B(i - j)
         If e > 2040000000 Then '减少进位次数
            e = e - 2040000000
            e1 = e1 + 204000
         End If
      Next j

      If j1 > 1 Then j1 = j1 - 1
base = 10000
      d = e \ base
      c(i) = e - d * base
      If Len(c(i)) < 4 Then
      c(i) = String(4 - Len(c(i)), "0") & c(i)
      Else
      c(i) = c(i)
      End If
jc = c(i) & jc
      e1 = e1 + d
Next i
jc = d & jc
MbC = qqdl(Trim(jc))
End Function

Private Function qqdl(sa As String) As String
'去前导0的程序

  For i = 1 To Len(sa)
If Not Mid(sa, i, 1) = "0" Then
      Exit For
End If
Next
strTmp = Mid(sa, i)
  If Len(strTmp) = 0 Then
  qqdl = "0"
  Else
qqdl = strTmp
End If
End Function
Public Function MPC(D1 As String, d2 As String) As String 'jianfaqi
'减法可调用程序
Dim x, y '两数长度
If Len(D1) >= Len(d2) Then
D4 = String(Len(D1) - Len(d2), "0") & d2
d3 = D1
Else
D4 = d2
d3 = String(Len(d2) - Len(D1), "0") & D1
End If
x = Len(d3): y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, e1() As Integer
ReDim a(1 To x)
ReDim B1(1 To y)
ReDim C1(1 To x)
ReDim e1(1 To x)
Dim i, j, c2, CJ, JW
For j = y To 1 Step -1 'D2
JW = 1 'yu jie weichuzhi
B1(j) = Mid$(D4, j, 1) '每位数
For i = x To 1 Step -1  'D1
  a(i) = Mid$(d3, i, 1) '每位数
  C1(i) = 10 + a(i) - B1(i) - 1 + JW '计算jia
  JW = C1(i) \ 10
  e1(i) = C1(i) Mod 10
Next
Next
For r = 1 To x
MPC = MPC & e1(r)
For i = 1 To Len(MPC)
If Not Mid(MPC, i, 1) = "0" Then
   Exit For
End If
Next
strTmp = Mid(MPC, i)
If Len(strTmp) = 0 Then
MPC = "0"
Else
MPC = strTmp
End If
Next

End Function

Public Function DeleteSpace(Tmp As String) As String
'去掉空格的程序
Dim Inst As Integer
Do
   Tmp = Replace(Tmp, " ", "")
   DoEvents
   Inst = InStr(Tmp, " ")
Loop While Inst > 0
DeleteSpace = Tmp
End Function

Public Function MCC1(D1 As String, d2 As String) As String '大整数的除法
'除法可调用程序
Dim ss
ss = MBJC(D1, d2)
If ss = -1 Then
MCC1 = "0" & "/" & D1
Else
If ss = 0 Then
MCC1 = 1
Else
If Len(D1) = Len(d2) Then
s = Val(Left(D1, 1)) \ Val(Left(d2, 1))

Do While MBJC(MbC(Trim(s), Trim(d2)), D1) = 1
  s = s - 1
  Loop
  If MBJC(MbC(Trim(s), Trim(d2)), D1) = 0 Then
MCC1 = s
Else
MCC1 = s & "/" & MPC(Trim(D1), MbC(Trim(s), Trim(d2)))

End If

  Else
  If Len(d2) < 9 Then
MCC1 = MCC(D1, d2)
Else
  Dim x, y '定义分段长度
  x = Len(D1): y = Len(d2)

Dim JW, jcc, jss, jcs
Dim a() As String, B() As String

ReDim a(1 To x)
ReDim B(1 To y)
For i = 1 To x
a(i) = Mid(D1, i, 1)
Next
For j = 1 To y
B(j) = Mid(d2, j, 1)
Next
jcc = Val(a(1) & a(2)) \ Val(B(1) & B(2))



jss = MbC(Trim(jcc), d2)
For i1 = 1 To y
  jws = jws & a(i1)
Next
JW = MPC(Trim(jws), Trim(jss))

  Z = x - y

  Dim c() As String
  ReDim c(1 To Z)
  For s = 1 To Z
If MBJC(JW & a(s + y), d2) = -1 Then
   c(s) = "0"
   Else
jwc = Val(Left(JW & a(s + y), 3)) \ Val(Left(d2, 2))
If Len(jwc) > 1 Then
c(s) = "9"
   Else
   c(s) = jwc
   End If

Do While MBJC(JW & a(s + y), MbC(Val(c(s)), d2)) = -1
  c(s) = Right(10000 + Val(c(s) - 1), 1)
Loop
End If

JW = MPC(JW & a(s + y), MbC(Val(c(s)), d2))

  jcc = jcc & c(s)
  Next s
  If JW = 0 Then
  MCC1 = jcc
  Else
  MCC1 = jcc & "/" & JW
  End If

For i = 1 To Len(MCC1)
  If Not Mid(MCC1, i, 1) = "0" Then
   Exit For
  End If
Next
strTmp = Mid(MCC1, i)
If Len(strTmp) = 0 Then
MCC1 = "0"
Else
MCC1 = strTmp
End If



  End If






End If
End If
End If
End Function

Public Function MCC(D1 As String, d2 As String) As String '除数少于8位的除法
'除法可调用程序除数少于8位的
If Len(D1) < Len(d2) Then
MCC = "0" & "/" & D1
Else
If Len(D1) < 9 Then
  ja = Val(D1) \ Val(d2)
  If Val(D1) - (Val(D1) \ Val(d2)) * Val(d2) = 0 Then

  MCC = ja
  Else

  MCC = ja & "/" & Val(D1) - (Val(D1) \ Val(d2)) * Val(d2)
  End If
  Else

Dim x 'fen duan changdu
x = Len(D1)



Dim a() As String
ReDim a(1 To x)  '定义数组的储存空间
For i = 1 To x Step 1  '把被除数各位放在a()中
   a(i) = Mid(D1, i, 1)


   Next i
Dim B() As String
JW = 0
ReDim B(1 To x)
For j = 1 To x Step 1
  B(j) = Val(JW & a(j)) \ Val(d2)
JW = Val(JW & a(j)) - Val(B(j)) * Val(d2)
   Next j
   For r = 1 To x
   If JW = 0 Then
      MCC = MCC & B(r)
      Else
      CJ = CJ & B(r)
      MCC = CJ & "/" & JW

  End If

  For i = 1 To Len(MCC)
If Not Mid(MCC, i, 1) = "0" Then
   Exit For
End If
Next
strTmp = Mid(MCC, i)
If Len(strTmp) = 0 Then
MCC = "0"
Else
MCC = strTmp
End If

Next

End If

End If

End Function
Public Function MPC1(D1 As String, d2 As String) As String 'jiafa
'加法可调用程序
Dim x, y '两数长度
If Len(D1) >= Len(d2) Then
D4 = String(Len(D1) - Len(d2), "0") & d2
d3 = D1
Else
D4 = d2
d3 = String(Len(d2) - Len(D1), "0") & D1
End If
x = Len(d3): y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, e1() As Integer
ReDim a(1 To x)
ReDim B1(1 To y)
ReDim C1(1 To x)
ReDim e1(1 To x)
Dim i, j, c2, CJ, JW
For j = y To 1 Step -1 'D2
JW = 0 '进位清0
B1(j) = Mid$(D4, j, 1) '每位数
For i = x To 1 Step -1  'D1
  a(i) = Mid$(d3, i, 1) '每位数
  C1(i) = a(i) + B1(i) + JW '计算jia
  JW = C1(i) \ 10
  e1(i) = C1(i) Mod 10
Next
Next
For r = 1 To x
If JW = 0 Then
MPC1 = MPC1 & e1(r)
Else
jc = jc & e1(r)
MPC1 = JW & jc
End If
Next

End Function

Private Function ydxsd(sa As String, sd As String) As String
'移动小数点的程序
If Len(sa) = 1 And Trim(sa) = 0 Then
  ydxsd = 0
  Else

sc = InStr(sa, ".")
If Val(sc) = 0 Then
ydxsd = sa & String(sd, "0")
Else
se = Left(sa, Val(sc) - 1)
sf = Right(sa, Len(sa) - Val(sc))
If Val(Len(sf)) >= Val(sd) Then
ydxsd = se & Mid(sf, 1, sd)
   Else
   ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
   End If
   End If
   End If
   End Function

Private Function fhys(sa As String) As String
'符号提取运算程序
If InStr(sa, "-") = 0 Then
  fhys = 1
Else
fhys = -1
End If

End Function
Private Function tjfh(sa As String, sf As String) As String 'qianjia fuhao
'添加符号的程序
If Val(sf) < 0 Then
tjfh = "-" & sa
Else
tjfh = sa
End If

End Function
Private Function jcjs(sa As String) As String
'计算阶乘的程序
Dim s
s = 1
For i = 1 To sa
s = MbC(Trim(s), Val(i))
Next
jcjs = s

End Function

Private Function qdfh(sa As String) As String
'去掉符号的程序
If InStr(sa, "-") > 0 Then
qdfh = Mid(sa, 2)
Else
If InStr(sa, "+") > 0 Then
qdfh = Mid(sa, 2)
Else
qdfh = sa
End If
End If

End Function

Private Function mbbc3(sa As String, sd As String) As String 'kai lifang jingdu daifh
'带符号的开立方的程序，高精度的可以精确到点后sd位的
Dim ja
If Val(Len(sa)) = 1 And Trim(sa) = 0 Then
mbbc3 = 0
Else

fh = fhys(sa)
ja = MBBC1(qdfh(sa) & String(Val(sd) * 2, "0"))
If InStr(ja, "/") = 0 And Val(fh) > 0 Then
mbbc3 = ja
Else
If InStr(ja, "/") = 0 And Val(fh) < 0 Then
mbbc3 = "-" & ja
Else
If Val(fh) > 0 Then
mbbc3 = Left(ja, InStr(ja, "/") - 1)
Else
mbbc3 = "-" & Left(ja, InStr(ja, "/") - 1)

End If
End If
End If
End If

End Function

'分段传了，下面接续：
Private Function mbbc2(sa As String, sd As String) As String 'kai pingfang jingdu
'开平方的程序，高精度的可以精确到点后sd位的
Dim ja
If Val(Len(sa)) = 1 And Trim(sa) = 0 Then
mbbc2 = 0
Else

ja = MBBC(Trim(sa) & String(Val(sd), "0"))

If InStr(ja, "/") = 0 Then
mbbc2 = ja
Else
mbbc2 = Left(ja, InStr(ja, "/") - 1)
End If
End If

End Function
Private Function mpc3(sa As String, sb As String) As String 'jiafa jingdu daifh
'带符号的加法计算程序
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) * Val(fh2) > 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))

If Val(fh1) > 0 Then
mpc3 = ja
Else
mpc3 = "-" & ja
End If
Else
xd = MBJC(qdfh(sa), qdfh(sb))
If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc3 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc3 = "-" & jb
Else
If Val(fh2) < 0 Then
mpc3 = "-" & jb
Else
mpc3 = jb
End If
End If
End If
End If

End Function

Private Function mpc2(sa As String, sb As String) As String 'jianfa jingdu daifh
'带符号的减法计算程序
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
xd = MBJC(qqdl(qdfh(sa)), qqdl(qdfh(sb)))
If Val(fh1) * Val(fh2) < 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))

If Val(fh1) > 0 Then
mpc2 = ja
Else

mpc2 = "-" & ja

End If
Else

If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc2 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc2 = "-" & jb
Else
If Val(fh2) <= 0 Then
mpc2 = jb
Else
mpc2 = "-" & jb
End If
End If
End If
End If

End Function
Private Function mbjc2(sa As String, sb As String) As String 'bi jiao dx daifh
'带符号的比较大小的程序
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) < Val(fh2) Then
mbjc2 = -1
Else
If Val(fh1) > Val(fh2) Then
mbjc2 = 1
Else

ja = MBJC(qdfh(sa), qdfh(sb))

If Val(fh1) > 0 And Val(ja) > 0 Then
mbjc2 = 1
Else
If Val(fh1) < 0 And Val(ja) > 0 Then
mbjc2 = -1
Else
If Val(fh1) > 0 And Val(ja) < 0 Then
mbjc2 = -1
Else
If Val(fh1) < 0 And Val(ja) < 0 Then
mbjc2 = 1
Else
mbjc2 = 0
End If
End If
End If
End If
End If
End If

End Function

Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu daifh
'带符号的乘法程序，输入精确到点后的位数
'输入的因数是移动了小数点后的数值，数值中没有小数点了
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If sa = "0" Or sb = "0" Then
mbc2 = 0
Else

ja = MbC(qdfh(sa), qdfh(sb))
If Val(Len(ja)) > Val(sd) Then
jb = Left(ja, Val(Len(ja)) - Val(sd))

If Val(fh1) * Val(fh2) > 0 Then
mbc2 = jb
Else
mbc2 = "-" & jb
End If

Else
mbc2 = 0
End If
End If

End Function

Private Function mcc2(sa As String, sb As String, sd As String) As String 'chufa jingdu daifh
'带符号的除法程序，输入精确到点后的位数
'输入的数值是移动了小数点后的数值，数值中没有小数点了
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)

ja = MCC1(qdfh(sa) & String(sd, "0"), qdfh(Trim(sb)))
If InStr(ja, "/") = 0 And Val(fh1) * Val(fh2) > 0 Then
mcc2 = ja
Else
If InStr(ja, "/") = 0 And Val(fh1) * Val(fh2) < 0 Then
mcc2 = "-" & ja
Else
If Val(fh1) * Val(fh2) > 0 Then
mcc2 = Left(ja, InStr(ja, "/") - 1)
Else
mcc2 = "-" & Left(ja, InStr(ja, "/") - 1)
End If
End If
End If

End Function

Public Function MBBC1(D1 As String) As String 'kai lifang
'开立方的程序
If Len(D1) < 10 Then
jss = Int((D1) ^ (1 / 3))
If (Val(jss) + 1) ^ 3 - Val(D1) = 0 Then
  jss = Val(jss) + 1
  Else
  jss = jss
  End If

JW = Val(D1) - (jss) ^ 3
  If JW = 0 Then
  MBBC1 = jss
  Else
  MBBC1 = jss & "/" & JW
End If
Else
Dim x 'shuju changdu
x = Len(D1) \ 3
d2 = String(3 - Len(D1) + 3 * x, "0") & D1
Dim a() As String
ReDim a(3 To 3 * x + 3)
Dim B() As String
ReDim B(1 To x)
Dim i, j, js
  For i = 3 To 3 * x + 3 Step 3

a(i) = Mid(d2, i - 2, 3)
Next
js = Int((Val(a(3) & a(6))) ^ (1 / 3))
If (Val(js) + 1) ^ 3 - Val(a(3) & a(6)) = 0 Then
js = Val(js) + 1
Else
js = js
End If

JW = Val(a(3) & a(6)) - (js) ^ 3

j = 2
Do While j <= x

jws = MPC1(JW & "000", a(3 * j + 3))
If MBJC(Trim(jws), MPC1(MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), 1)), 3), 1)) < 0 Then
B(j) = "0"
Else
jwc = Left(jws, 2) \ Left(MPC1(MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), 1)), 3), 1), 1) '2=Len(jws) - Len(MbC(MbC(Trim(js), MPC1(Trim(js), 1)), 30)) + 1
If Len(jwc) > 1 Then
   B(j) = 9
   Else
   B(j) = jwc
   End If


   Do While MBJC(Trim(jws), MbC(MPC1(MbC(B(j), B(j)), MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), Trim(B(j)))), 3)), B(j))) = -1

   B(j) = B(j) - 1

            Loop
      End If
      JW = MPC(Trim(jws), MbC(MPC1(MbC(B(j), B(j)), MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), Trim(B(j)))), 3)), B(j)))

   js = MPC1(MbC(Trim(js), 10), Trim(B(j)))


j = j + 1
If JW = 0 Then

MBBC1 = js
Else
MBBC1 = js & "/" & JW
End If
Loop

End If
End Function

Private Function shuchujg(sa As String, sd As String) As String
'输出结果的程序，包括添加符号和移动回去小数点就是添加上小数点
'shuchu jieguo
If Len(qqdl(sa)) = 1 And Trim(qqdl(sa)) = 0 Then
shuchujg = 0
Else
sa1 = MPC1(qdfh(Trim(sa)), 49)
fsa = fhys(Trim(sa))
If Len(sa1) = Val(sd) Then
a1 = 0
jb1 = sa1
Else
If Len(sa1) < Val(sd) Then
a1 = 0
jb1 = String(Val(sd) - Len(sa1), "0") & sa1
Else
a1 = Left(sa1, Len(sa1) - Val(sd))
jb1 = Right(sa1, Val(sd))
End If
End If
jb2 = Left(jb1, Val(sd) - 2)
If MBJC(qqdl(Trim(jb2)), 0) = 0 Then
  shuchujg = tjfh(Trim(a1), Val(fsa))
  Else
  shuchujg = tjfh(Trim(a1), Val(fsa)) & "." & jb2
  End If
  End If

End Function

Public Function jie4cifc(a2 As String, b2 As String, c2 As String, d2 As String, k2 As String, sd As String) As String
'解四次方程的程序，输入数值是移动了小数点后的数值，数值中没有小数点了
'a为三次项的系数，k为4次项的系数，注意a和k的输入顺序和位置
'解四次方程的代码如下（这个运行结果是对的）
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))

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

		自动登录	找回密码
密码			注册