设为首页收藏本站
开启辅助访问 切换到窄版

数学中国

 找回密码
 注册
搜索
热搜: 活动 交友 discuz
数学中国»论坛 › 数学中国综合论坛 › www.fea-league.com › [原创]1元3次方程的高精度求解程序
1234567
返回列表 发新帖
楼主: ysr

[原创]1元3次方程的高精度求解程序

[复制链接]
ysr
 楼主| 发表于 2021-3-26 07:20 | 显示全部楼层
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
回复 支持 反对

使用道具 举报

ysr
 楼主| 发表于 2021-3-26 07:20 | 显示全部楼层
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
回复 支持 反对

使用道具 举报

ysr
 楼主| 发表于 2021-3-29 17:29 | 显示全部楼层
50000000000000000000000000000000000000000000000000有50位，用时0.1171875秒。
4999999999999999999999999有25位，用时1.953125E-02秒。
回复 支持 反对

使用道具 举报

ysr
 楼主| 发表于 2021-10-9 21:04 | 显示全部楼层
a=39999999996,  b=21241344505137653303271256205975909031850472921958486285631797928920343932019088565800989143159036408571488196760455145602984590077299141215947023738764836883923957280174642070668037124369220583286702913887821225200462618544213638360656837313868543054453204302340171454654519583468816251505411042571730279232042642,  c=-1951191957114491043187111003744240513685396725981970629700710592563680703161968062370246036247738627032370776501014825399578161547000831606748843002168672887266981305885740089833139439234323312695689625412024016829122514656507352697981125344172844182368114896236204294508761826152843899201150343200419170198841181454499695112972039277169857589103330332516778218713360725725082880123548599155173235731977113308303929525753084046652279665323521176182511016509337945802477164322442754239154171153444727656083315005522259787528994374990506573372903459740066945054438772954241072879370192381308965332584716393292007562526,  d=-216792236953088797785557426147175016480835979323601258454595459057405407109500710000222110176638963745499887538267297241860204573537958656879758619547730550707989797798638090652965027992666051661081354903349381010021568169801381358601575304767490763312379383717409889385012289204908539060966394770871246890777921577796400679923771501783071767685067014230668324441759624231587300730718488251594063930439298708075160226825603119151968357487679664817789401982426997818018841295057403950609671584856962188531387961494828844871624172727314550961787232375563373679053356312901697726798898168651274242911220397249972289143606823648656029476712946366892985067881733055039665560864738606630269304867199930437117227487723395630590146878988449912817306101028559746089717635835196166532880406038782311921112655183019964459374526531829275945548899482430576251950337782981678961801144378794060370826243910857369354736905190898585548273312;  输出结果1:    x1=17391206407497509168439017164631835412661948579454092237941266406724812349364517991083458607865109227810861664588119790780079556388335865311349415747203073246889517472385104679129770836785134965668824678351833284902944126791109264066411327127744305519546305614910126506187885873637491153828401714352225750.8460728435,  x2=-8961120010089526931144476519583113362955824766914012245259727290102819882506538973396669666007536605220072633885029764869174072518047601353262012540094827551143137294964573221325437970623237995348563176850929491533979131035608009276719211754646864367031289021960129017727631008075474587183691396235208557.8193465230+15209829842613369522386038024785857715906403492093369737321031820586564564280690953067388979568419191420413356213460535123892760256947918811457804954869593351471570501534016393631382829217581687661817219286932621617938339275048454823156629237923920269655905344874330742047786684292807379799231386590924627.2434226119i,  x3=-8961120010089526931144476519583113362955824766914012245259727290102819882506538973396669666007536605220072633885029764869174072518047601353262012540094827551143137294964573221325437970623237995348563176850929491533979131035608009276719211754646864367031289021960129017727631008075474587183691396235208557.8193465230-15209829842613369522386038024785857715906403492093369737321031820586564564280690953067388979568419191420413356213460535123892760256947918811457804954869593351471570501534016393631382829217581687661817219286932621617938339275048454823156629237923920269655905344874330742047786684292807379799231386590924627.2434226119i m=585336909300409379380110879085417227371260343761293463545888523191958787190512361206617234627701887175998664176067495481135749738901656959838949699336059173074215400189667379362040924500729638885550971489952003685381927512911125967375612835774456340002260172793505922350366555737339839509492193420995410068621599203757956891580307982357929819060629975848389778744675309169951671557534187447148520595364250692593338228697446804137035562517849572444420745679471178639112073365211428187719608322953354666331190536548401500956243653991479880164803331878672903395520622444088736637354384269882090305084550804261077700291161403724470046759400955924663120552780136392737496134220033597860808309134389725299534984245681906534663302595796916535557718633381360339481716898709193904505218443684551735662631167447821134635221180210148294640974110263266090565059483060715811287684924650537984425686383371433342369834397061284109.9236285806 n=585336909296113044887643203774152503837067821323969678320590943145942342197041890593824424430666638414858641685795071682135301415478586935922853826775579462757460538939862929301308422204607154828782685133565026976320799076830213133398506353246964084544613718341467400209941316215355005139187353415542017760565107927242902420277632382242098376300146107264153776499305357934036309371818263308622697055713812459208653464562711781420002064588229531102299512219738460074844166402857328743229636361702662356430052805090077663013517005025614056711460696162038477912635849461657727147484643723168736292124306226853810138545936908275972487748312047621868975695037241935988723129079235883386450161520535115159864032092940792682997071304719500587605896822506592822528655575930650065668753474080702795917264427571608597446701533733697530443391852622329240307971167948358591947287414099443115209231816688282015425530828448917018.3337130850
回复 支持 反对

使用道具 举报

ysr
 楼主| 发表于 2021-10-9 21:07 | 显示全部楼层
n2=265518432282549657685129060023907872713145305065640536086399937186087223409400650668777431022192023001590896008821315925648752920065416091895806004113787669439558542869622369955992598287924462115263690745285909509891948844553138874323713865670513930928441289717474152729099297658439169723704512252477861

x1=17391206407497509168439017164631835412661948579454092237941266406724812349364517991083458607865109227810861664588119790780079556388335865311349415747203073246889517472385104679129770836785134965668824678351833284902944126791109264066411327127744305519546305614910126506187885873637491153828401714352225750.8460728435
回复 支持 反对

使用道具 举报

ysr
 楼主| 发表于 2021-10-9 21:25 | 显示全部楼层
本帖最后由 ysr 于 2021-10-10 02:32 编辑

Dim sng As Integer 'shuru zifu & '"√"41420
'具体方法是:先切换到非英语输入法(如:五笔/拼音),
'然后在输入法的状态栏上看到像键盘一样的按钮,在按钮上按右键,选"希腊字母",
'根着你就可在软键盘上看到你要的符号了.
'2"178",3"179",×"215",÷"247",°"176"

Private Sub Command1_Click()
Dim ja, jb, jc
k = DeleteSpace(Text1.Text)
ja = DeleteSpace(Text2.Text)
jb = DeleteSpace(Text3.Text)
jc = DeleteSpace(Text7.Text)
sd1 = DeleteSpace(Text10.Text)
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))
k2 = zhengliys2(Trim(k), Val(sd))
If MBJC(Trim(k2), 0) = 0 Then
Text4.Text = "a 不能为 0"
   Text5.Text = "a 为 0可能已不是1元3次方程"
  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))


   
   
   ' 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))
Text4.Text = shuchujg(Trim(tx1), Val(sd))
Text5.Text = shuchujg(Trim(tx2), Val(sd))
  Text6.Text = shuchujg(Trim(tx2), Val(sd))
  Text8.Text = shuchujg(Trim(tx3), Val(sd)) & "i"
  Text9.Text = shuchujg(Trim(tx3), Val(sd)) & "i"
  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
  Text4.Text = shuchujg(Trim(tx1), Val(sd))
Text5.Text = shuchujg(mpc3(Trim(tx2), Trim(tx3)), Val(sd))
  Text6.Text = shuchujg(mpc2(Trim(tx2), Trim(tx3)), Val(sd))
  Text8.Text = ""
  Text9.Text = ""
  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
  Text4.Text = shuchujg(Trim(tx1), Val(sd))
Text5.Text = shuchujg(mpc3(Trim(tx2), Trim(tx3)), Val(sd))
  Text6.Text = shuchujg(mpc2(Trim(tx2), Trim(tx3)), Val(sd))
  Text8.Text = ""
  Text9.Text = ""
  
  End If
  
End If


  End If
  Label3.Caption = Val(Label3.Caption) + 1
  Label2.Caption = "输出结果"
  
  If Text8.Text = "" Then
  Text11.Text = Text11.Text & "  输入" & Label3.Caption & ":  " & "a=" & k & ",  b=" & ja & ",  c=" & jb & ",  d=" & jc _
  & ";  输出结果" & Label3.Caption & ":    " & "x1=" & Text4.Text & ",  x2=" & Text5.Text & ",  x3=" & Text6.Text _
  & " m=" & shuchujg(Trim(m), Val(sd)) & " n=" & shuchujg(Trim(n5), Val(sd)) & "i"
  Else
  
  Text11.Text = Text11.Text & "  输入" & Label3.Caption & ":  " & "a=" & k & ",  b=" & ja & ",  c=" & jb & ",  d=" & jc _
  & ";  输出结果" & Label3.Caption & ":    " & "x1=" & Text4.Text & ",  x2=" & Text5.Text & "+" & Text8.Text & ",  x3=" & Text6.Text & "-" & Text9.Text _
  & " m=" & shuchujg(Trim(m), Val(sd)) & " n=" & shuchujg(Trim(n5), Val(sd))
  
  End If
  
End Sub

Private Sub Command10_Click()
Text11.Text = "1，最好输入数值 2，鲍丰武原理，王彦会程序设计 " _
& "3，编制于2013.05.02 4，有需要的请与我们联系 5，原理见《数学中国》" _
& "论坛，“风花飘飘”版作品6,兼容1元1次/2次/3次方程"
Label2.Caption = "提示2"
End Sub

Private Sub Command11_Click()
Text11.Text = ""
End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
End Sub

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




回复 支持 反对

使用道具 举报

ysr
 楼主| 发表于 2021-10-9 21:27 | 显示全部楼层
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

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

回复 支持 反对

使用道具 举报

ysr
 楼主| 发表于 2021-10-9 21:27 | 显示全部楼层
Private Function qqdl(sa As String) As String

  
  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位的除法
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
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
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

Private Sub Command4_Click()
Label2.Caption = ""
Label3.Caption = ""
Text10.Text = ""

End Sub

Private Sub Command5_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = "("
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = "("
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = "("
End If

If sng = 7 Then

Text7.SetFocus
Text7.SelText = "("
End If
   
   
   
End Sub

Private Sub Command6_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = "√"
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = "√"
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = "√"
End If

If sng = 7 Then

Text7.SetFocus
Text7.SelText = "√"
End If
   
   
   
End Sub

Private Sub Command7_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = ")"
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = ")"
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = ")"
End If

If sng = 7 Then

Text7.SetFocus
Text7.SelText = ")"
End If
   
   
   
End Sub

Private Sub Command8_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = "/"
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = "/"
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = "/"
End If

If sng = 7 Then

Text7.SetFocus
Text7.SelText = "/"
End If
   
   
   
End Sub

Private Sub Command9_Click()
Text11.Text = "1，可以输入含根式和分数的多项式，但3次以上不行" _
& "2，只能有√()和/号，不能有*等其他运算符号，符号不能连用如++，+-，--，" _
& "3，单项式分数的分母不能有√号，  4，单项式分数的分子分母不能再有分数，" _
& "但可以有小数   5，可以有()号但只能有1个，  6，(号左边可以有系数但不能有*号等，最好是数值，" _
& "7，)号右边紧跟/号,且/号右边必须有数字，至少为1不能为0，最好是数值，可以是小数"
Label2.Caption = "提示1"


End Sub

Private Sub Text1_GotFocus()
sng = 1
End Sub



Private Sub Text2_GotFocus()
sng = 2
End Sub
Private Sub Text3_GotFocus()
sng = 3
End Sub

Private Sub Text7_GotFocus()
sng = 7
End Sub









Private Sub Command3_Click()
Text6.Text = Text6.Text & "   1，必须输入数值 " _
& "2，鲍丰武原理，王彦会程序设计 " _
& "3，编制于2013.05.02 " _
& "4，有需要的请与我们联系 " _
& "5，原理见《数学中国》论坛，“风花飘飘”版作品   " _
& "6，输入系数精度要 与要求的 匹配，如输入0.00000 00000 01（点后12位），要求精度 " _
& "为0.00000 00001（点后10位），不 匹配，程序可能会当0处理"
End Sub


回复 支持 反对

使用道具 举报

ysr
 楼主| 发表于 2021-12-2 11:56 | 显示全部楼层
本帖最后由 ysr 于 2021-12-3 13:54 编辑

发一下这个可执行程序，代码就是前面刚发过的这个代码。已经用快速乘法代替了原来的大整数的乘法，速度和效率都有所提高。

最高可以精确到点后300位，程序设定的是最高点后300位的精度，当你的输入精确度要求超过点后300时，输出的仍然是300位。
当你不输入精确度要求时，则输出精确到点后10位。
当输出点后300位的精确度，程序运行时间不超过5分钟。速度可以忍受的。

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有帐号？注册

x
回复 支持 反对

使用道具 举报

ysr
 楼主| 发表于 2022-12-11 06:00 | 显示全部楼层
本帖最后由 ysr 于 2022-12-18 13:37 编辑

Dim sng As Integer 'shuru zifu & '"√"41420
'具体方法是:先切换到非英语输入法(如:五笔/拼音),
'然后在输入法的状态栏上看到像键盘一样的按钮,在按钮上按右键,选"希腊字母",
'根着你就可在软键盘上看到你要的符号了.
'2"178",3"179",×"215",÷"247",°"176"

Private Sub Command1_Click()
Dim jk, A, B, c, d
jk = DeleteSpace(Trim(Text1.Text))
A = DeleteSpace(Trim(Text2.Text))
B = DeleteSpace(Trim(Text3.Text))
c = DeleteSpace(Trim(Text4.Text))
d = DeleteSpace(Trim(Text5.Text))
sd1 = DeleteSpace(Text14.Text)
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(A), Val(sd))
b2 = zhengliys2(Trim(B), Val(sd))
C2 = zhengliys2(Trim(c), Val(sd))
D2 = zhengliys2(Trim(d), Val(sd))
k2 = zhengliys2(Trim(jk), Val(sd))
If MBJC(Trim(k2), 0) = 0 Then
Text4.Text = "a 不能为 0"
   Text5.Text = "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))

c4 = mpc2(Trim(b3), mcc2(mbc2(3 & String(Val(sd), "0"), mbc2(Trim(a3), Trim(a3), Val(sd)), Val(sd)), 8 & String(Val(sd), "0"), Val(sd)))
d4 = mpc3(Trim(c3), mpc2(mcc2(mbc2(Trim(a3), mbc2(Trim(a3), Trim(a3), Val(sd)), Val(sd)), 8 & String(Val(sd), "0"), Val(sd)), mcc2(mbc2(Trim(a3), Trim(b3), Val(sd)), 2 & String(Val(sd), "0"), Val(sd))))
je = mpc3(mpc2(mcc2(mbc2(Trim(b3), mbc2(Trim(a3), Trim(a3), Val(sd)), Val(sd)), 16 & String(Val(sd), "0"), Val(sd)), mcc2(mbc2(3 & String(Val(sd), "0"), mbc2(mbc2(Trim(a3), Trim(a3), Val(sd)), mbc2(Trim(a3), Trim(a3), Val(sd)), Val(sd)), Val(sd)), 256 & String(Val(sd), "0"), Val(sd))), mpc2(Trim(d3), mcc2(mbc2(Trim(a3), Trim(c3), Val(sd)), 4 & String(Val(sd), "0"), Val(sd))))
'至此已经把原方程化成了缺3次项的方程，下面就可以用求根公式解方程了。
p1 = mcc2(mpc3(mbc2(12 & String(Val(sd), "0"), Trim(je), Val(sd)), mbc2(Trim(c4), Trim(c4), Val(sd))), 3 & String(Val(sd), "0"), Val(sd))
If Val(fhys(Trim(p1))) < 0 Or Val(p1) = 0 Then
p = qdfh(Trim(p1))
Else
p = tjfh(Trim(p1), Val(-1))
End If
q = mcc2(mpc2(mpc2(mbc2(72 & String(Val(sd), "0"), mbc2(Trim(c4), Trim(je), Val(sd)), Val(sd)), mbc2(2 & String(Val(sd), "0"), mbc2(mbc2(Trim(c4), Trim(c4), Val(sd)), Trim(c4), Val(sd)), Val(sd))), mbc2(27 & String(Val(sd), "0"), mbc2(Trim(d4), Trim(d4), Val(sd)), Val(sd))), 27 & String(Val(sd), "0"), Val(sd))
dp1 = mpc3(mcc2(mbc2(Trim(p), Trim(p), Val(sd)), 4 & String(Val(sd), "0"), Val(sd)), mcc2(mbc2(Trim(q), mbc2(Trim(q), Trim(q), Val(sd)), Val(sd)), 27 & String(Val(sd), "0"), Val(sd)))
If Val(fhys(Trim(dp1))) < 0 Then
dp = mbbc2(qdfh(Trim(dp1)), Val(sd))
dp2 = mcc2(Trim(dp), mcc2(Trim(q), 2 & String(Val(sd), "0"), Val(sd)), Val(sd))
dp3 = mcc2(jsfanzq(qdfh(Trim(dp2)), Val(sd)), 3 & String(Val(sd), "0"), Val(sd))
dp4 = jsyuxian(Trim(dp3), Val(sd))
dp5 = jszhxian(Trim(dp3), Val(sd))
q2 = mcc2(Trim(q), 2 & String(Val(sd), "0"), Val(sd))
q1 = qdfh(Trim(q2))
jr = mbbc3(mbbc2(MPC1(mbc2(Trim(q1), Trim(q1), Val(sd)), mbc2(Trim(dp), Trim(dp), Val(sd))), Val(sd)), Val(sd))
jr2 = mbc2(MbC(2, Trim(jr)), Trim(dp4), Val(sd))
jr3 = mcc2(mbc2(2 & String(Val(sd), "0"), Trim(c4), Val(sd)), 3 & String(Val(sd), "0"), Val(sd))
r = mpc2(Trim(jr2), Trim(jr3))

Else
dp = mbbc2(Trim(dp1), Val(sd))
q2 = mcc2(Trim(q), 2 & String(Val(sd), "0"), Val(sd))
If Val(fhys(Trim(q2))) < 0 Or Val(q2) = 0 Then
q1 = qdfh(Trim(q2))
Else
q1 = tjfh(Trim(q2), Val(-1))
End If
jr1 = mbbc3(mpc3(Trim(q1), Trim(dp)), Val(sd))
jr2 = mbbc3(mpc2(Trim(q1), Trim(dp)), Val(sd))
jr3 = mcc2(mbc2(2 & String(Val(sd), "0"), Trim(c4), Val(sd)), 3 & String(Val(sd), "0"), Val(sd))
r = mpc2(mpc3(Trim(jr1), Trim(jr2)), Trim(jr3))
End If
If Val(fhys(Trim(r))) < 0 Then
dr = mbbc2(qdfh(Trim(r)), Val(sd))
Else
dr = mbbc2(Trim(r), Val(sd))
End If
h = mcc2(mpc3(Trim(c4), Trim(r)), 2 & String(Val(sd), "0"), Val(sd))
k1 = mcc2(Trim(d4), mbc2(2 & String(Val(sd), "0"), Trim(r), Val(sd)), Val(sd))
If Val(fhys(Trim(k1))) < 0 Or Val(k1) = 0 Then
k = qdfh(Trim(k1))
Else
k = tjfh(Trim(k1), Val(-1))
End If
h2 = mpc2(Trim(r), mbc2(4 & String(Val(sd), "0"), Trim(h), Val(sd)))
k2 = mbc2(mbc2(4 & String(Val(sd), "0"), Trim(k), Val(sd)), Trim(dr), Val(sd))
If Val(fhys(Trim(r))) < 0 Then
dh = mcc2(Trim(k2), Trim(h2), Val(sd))
dh1 = jsfanzq(qdfh(Trim(dh)), Val(sd))
dk1 = jsyuxian(Trim(dh1), Val(sd))
dk2 = jszhxian(Trim(dh1), Val(sd))
k3 = mbbc2(mpc3(mbc2(qdfh(Trim(h2)), qdfh(Trim(h2)), Val(sd)), mbc2(qdfh(Trim(k2)), qdfh(Trim(k2)), Val(sd))), Val(sd))
k4 = mbbc2(Trim(k3), Val(sd))
X1 = mcc2(mpc3(Trim(h2), mbc2(Trim(k4), Trim(dk1), Val(sd))), 2 & String(Val(sd), "0"), Val(sd))
X12 = mcc2(mpc3(Trim(dr), mbc2(Trim(k4), Trim(dk2), Val(sd))), 2 & String(Val(sd), "0"), Val(sd))
X1 = shuchujg(Trim(X1), Val(sd))
X12 = shuchujg(Trim(X12), Val(sd))
Text15 = "输入系数a=" & jk & " b=" & A & " c=" & B & " d=" & c & " e=" & d & " 输出结果x1=" & X1 & "+" & X12 & "i"
Else
dk1 = mpc2(Trim(h2), Trim(k2))
dk2 = mpc3(Trim(h2), Trim(k2))
If Val(fhys(Trim(dk2))) > 0 Then
X1 = mpc3(Trim(dr), mbbc2(qdfh(Trim(dk2)), Val(sd)))
X1 = shuchujg(Trim(X1), Val(sd))
Text15 = "输入系数a=" & jk & " b=" & A & " c=" & B & " d=" & c & " e=" & d & " 输出结果x1=" & X1
Else
X1 = mcc2(Trim(dr), 2 & String(Val(sd), "0"), Val(sd))
X12 = mcc2(mbbc2(qdfh(Trim(dk2)), Val(sd)), 2 & String(Val(sd), "0"), Val(sd))
X1 = shuchujg(Trim(X1), Val(sd))
X12 = shuchujg(Trim(X12), Val(sd))
Text15 = "输入系数a=" & jk & " b=" & A & " c=" & B & " d=" & c & " e=" & d & " 输出结果x1=" & X1 & "+" & X12 & "i"
End If
End If


End If

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Text5 = ""

Text6 = ""
Text7 = ""
Text8 = ""
Text9 = ""

Text10 = ""
Text11 = ""
Text12 = ""
Text13 = ""


End Sub

Private Sub Command8_Click()
Label2.Caption = ""
Label3.Caption = ""
Text10.Text = ""

End Sub

Private Sub Command4_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = "("
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = "("
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = "("
End If

If sng = 4 Then

Text4.SetFocus
Text4.SelText = "("
End If
   
If sng = 5 Then

Text5.SetFocus
Text5.SelText = "("
End If
   
   
End Sub

Private Sub Command5_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = "√"
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = "√"
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = "√"
End If

If sng = 4 Then

Text4.SetFocus
Text4.SelText = "√"
End If
   
If sng = 5 Then

Text5.SetFocus
Text5.SelText = "√"
End If


   
End Sub

Private Sub Command6_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = ")"
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = ")"
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = ")"
End If

If sng = 4 Then

Text4.SetFocus
Text4.SelText = ")"
End If

If sng = 5 Then

Text5.SetFocus
Text5.SelText = ")"
End If
   
   
   
End Sub

Private Sub Command7_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = "/"
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = "/"
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = "/"
End If

If sng = 4 Then

Text4.SetFocus
Text4.SelText = "/"
End If

If sng = 5 Then

Text5.SetFocus
Text5.SelText = "/"
End If
   
   
   
End Sub

Private Sub Command9_Click()
Text11.Text = "1，可以输入含根式和分数的多项式，但3次以上不行" _
& "2，只能有√()和/号，不能有*等其他运算符号，符号不能连用如++，+-，--，" _
& "3，单项式分数的分母不能有√号，  4，单项式分数的分子分母不能再有分数，" _
& "但可以有小数   5，可以有()号但只能有1个，  6，(号左边可以有系数但不能有*号等，最好是数值，" _
& "7，)号右边紧跟/号,且/号右边必须有数字，至少为1不能为0，最好是数值，可以是小数"
Label2.Caption = "提示1"


End Sub

Private Sub Text1_GotFocus()
sng = 1
End Sub



Private Sub Text2_GotFocus()
sng = 2
End Sub
Private Sub Text3_GotFocus()
sng = 3
End Sub

Private Sub Text4_GotFocus()
sng = 4
End Sub

Private Sub Text5_GotFocus()
sng = 5
End Sub







Private Sub Command3_Click()
Text6.Text = Text6.Text & "   1，必须输入数值 " _
& " 2，鲍丰武原理，和陆元鸿教授的消去3次项的公式，王彦会程序设计 " _
& " 3，编制于2022.12.12 " _
& " 4，有需要的请与我们联系 " _
& " 5，原理见《数学中国》论坛，“风花飘飘”版作品   " _
& " 6，输入系数精度要 与要求的 匹配，如输入0.00000 00000 01（点后12位），要求精度 " _
& "为0.00000 00001（点后10位），不 匹配，程序可能会当0处理"
End Sub


回复 支持 反对

使用道具 举报

1234567
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies E
您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|数学中国 ( 京ICP备05040119号 )

GMT+8, 2025-5-10 11:48 , Processed in 0.099383 second(s), 14 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表