ysr 发表于 2021-3-2 04:28

输入:Text1=80607000,结果: 21+0i12.9497474683058+-10.9497474683058i2.00000000000001+-7i3.05025253169417+1.05025253169416i7+0i3.05025253169417+-1.05025253169417i1.99999999999999+7i12.9497474683058+10.9497474683058i.

ysr 发表于 2021-3-2 04:32

“让那些内外反动派在我们面前发抖吧,让他们去说我们这也不行那也不行吧,中国人民不屈不挠的努力必将稳步地达到自己的目的!”
“我们的目的一定要达到,我们的目的一定能够达到!”————毛主席语录

ysr 发表于 2021-3-2 07:01

倒序程序修改了一下就正确了:
输入:Text1=00000678,结果:80607000.
输入:Text1=00000432,结果:20403000.

代码如下:
Private Sub Command1_Click()
   Dim x_() As Double, a As String
   a = Trim(Text1)
   ReDim x_(1 To Len(a))
   For i1 = 1 To Len(a)
   x_(i1) = Mid(a, Len(a) - i1 + 1, 1)
   Next
   Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, k As Long
   '位序倒置
n = Len(a) '求数组大小,其值必须是2的幂
lh = n / 2
   j = n / 2
   For i = 1 To n - 2


   Debug.Print i, j
   k = lh '下面是向右进位算法
Do
   If k > j Then Exit Do '高位是1吗
j = j - k '是的,高位置0
   k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
j = j + k '非则若最高位是0,则置1
   Text2 = Text2 & x_(j + 1)
   Next
   Text2 = x_(1) & x_(1 + Len(a) / 2) & Text2
   
   End Sub

   Private Sub Command2_Click()
   Text1 = ""
   Text2 = ""
   End Sub

ysr 发表于 2021-3-18 13:21

Private Function qdhz0(sa As String) As String
a = sa
Do While Right(a, 1) = "0"
a = Left(a, Len(a) - 1)
Loop
If a = "" Then
a = 0
Else
a = a
End If
qdhz0 = a
End Function


Private Function qdqd0(sa As String) As String
a = sa
Do While Left(a, 1) = "0"
a = Mid(a, 2)
Loop
If a = "" Then
a = 0
Else
a = a
End If
qdqd0 = a
End Function

去掉前导0和后缀0的程序,很重要。

ysr 发表于 2021-3-24 20:20

本帖最后由 ysr 于 2021-3-24 12:46 编辑

改进了一下除法程序,其实是把其中的大数减法可调用程序改进了一下,把其中的一维数组由一位的改为8位的,这样减法速度快了,由于除法程序大量调用大数减法,所以,速度有所提高,下面是验证结果:
9284564683560607824636349236036620084709403829405931331147437307957668341663495926748183799850251378750668211991763528582507888857722224558828540106085807378607424663142945342259084291023976378630973930107/107=86771632556641194622769619028379626959900970368279732066798479513623068613677532025683960746264031577109048710203397463387924194931983407091855515010147732510349763206943414413636301785270807276924990001有203位,用时1.476563秒。

把此程序重新发在前面,就是编辑修改了前楼的程序。

前楼的程序不改了,同样的结果,前楼居然用力不到1秒:
86771632556641194622769619028379626959900970368279732066798479513623068613677532025683960746264031577109048710203397463387924194931983407091855515010147732510349763206943414413636301785270807276924990001有203位,用时0.8671875秒。

把前楼中的大数减法可调用程序改了一下,稍快了一些:
86771632556641194622769619028379626959900970368279732066798479513623068613677532025683960746264031577109048710203397463387924194931983407091855515010147732510349763206943414413636301785270807276924990001有203位,用时0.6171875秒

ysr 发表于 2021-3-24 21:53

9284564683560607824636349236036620084709403829405931331147437307957668341663495926748183799850251378750668211991763528582507888857722224558828540106085807378607424663142945342259084291023976378630973930107/107=86771632556641194622769619028379626959900970368279732066798479513623068613677532025683960746264031577109048710203397463387924194931983407091855515010147732510349763206943414413636301785270807276924990001有203位,用时0秒(模仿手工计算的居然不需要时间,前面快速程序是有条件的,在大于300位才能显出优势的,这里说的快速程序就是基于快速乘法程序的牛顿迭代法除法程序)

ysr 发表于 2021-4-30 21:26

2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601/
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801用时63.59375秒(经过改进,这个除法程序速度有所提高)

ysr 发表于 2021-4-30 21:34

'这个程序的代码如下:

Private Sub Command1_Click() '快速除法程序
Dim a, B
a = Trim(Text1): B = Trim(Text2): b3 = B: a3 = a
ts = Timer
If Len(B) = 1 Then
X1 = Mid(B, 1, 1): X2 = 1 / X1 - 0.01
Else
X1 = Mid(B, 1, 2): X2 = 10 / X1 - 0.01
End If
x = Mid(X2, 1, 4)
Y = 0: x3 = 0
sb = Len(a3) + Len(b3) - 1 + 10
If Len(a3) = Len(b3) And MBJC(Trim(a3), Trim(b3)) = 0 Then
a1 = 1
ElseIf MBJC(Mid(a3, 1, Len(b3)), Trim(b3)) = 0 And Val(Len(qdhz0(Trim(a3)))) = Val(Len(b3)) Then
a1 = 1 & String(Len(a3) - Len(qdhz0(Trim(a3))), "0")
Else

a = a & String(10, "0"): B = B & String(10 + Len(a3), "0")
x = qdqd0(ydxsd(Trim(x), Val(sb)))
Y1 = 2 & String(Val(sb), "0")
Do While MBJC(MPC(Trim(x), Trim(x3)), 1) >= 0

s3 = s3 + 1
Y = mbc2(Trim(x), MPC(Trim(Y1), mbc2(Trim(B), Trim(x), Val(sb))), Val(sb))
x3 = x
x = Trim(Y)
Loop
a1 = mbc2(Trim(Y), Trim(a), Val(sb))
s = Len(a3) - Len(b3)
a1 = qdqd0(Trim(a1))

If MBJC(Mid(a3, 1, Len(b3)), Trim(b3)) < 0 Then
a1 = tjxsd(Trim(a1), Len(a1) - s)
Else
a1 = tjxsd(Trim(a1), Len(a1) - s - 1)
End If
End If

If InStr(a1, ".") = 0 Then
a1 = a1
Else
a1 = Left(a1, InStr(a1, ".") - 1)
End If
ja = MPC(Trim(a3), MbC(Trim(b3), Trim(a1)))
Do While MBJC(Trim(ja), Trim(b3)) >= 0
ja = MPC(Trim(ja), Trim(b3))
s5 = s5 + 1
Loop
a1 = MPC1(Trim(a1), Trim(s5))
If ja = 0 Then
Text3 = a1 & "用时" & Timer - ts & "秒,有" & Len(a1) & "位"
Else
Text3 = a1 & "/" & ja & "用时" & Timer - ts & "秒,整数部分有" & Len(a1) & "位"
End If
End Sub

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

End Sub
Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu
Dim ja

If Trim(sa) = 0 Or Trim(sb) = 0 Then
mbc2 = 0
Else


ja = MbC(Trim(sa), Trim(sb))
If Val(Len(ja)) > Val(sd) Then
jb = Left(ja, Val(Len(ja)) - Val(sd))
mbc2 = jb
Else
mbc2 = 0
End If


End If




End Function

Private Function qdhz0(sa As String) As String
a = sa
Do While Right(a, 1) = "0"
a = Left(a, Len(a) - 1)
Loop
If a = "" Then
a = 0
Else
a = a
End If
qdhz0 = a
End Function


Private Function qdqd0(sa As String) As String
a = sa
Do While Left(a, 1) = "0"
a = Mid(a, 2)
Loop
If a = "" Then
a = 0
Else
a = a
End If
qdqd0 = a
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

Private Function ydxsd(sa As String, sd As String) As String
If Len(sa) = 1 And Val(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
      
       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 = qdqd0(Trim(jc))
End Function
Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim x, Y ';两数长度
If qdqd0(D2) = "0" Then
MPC = D1
Else
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) \ 8: Y = Len(d4) \ 8
d3 = String(8 * x + 8 - Len(d3), "0") & d3
d4 = String(8 * Y + 8 - Len(d4), "0") & d4
x = x + 1: Y = Y + 1

Dim a() As String, B1() As String, C1() As String, E1() As String
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 * 8 - 7, 8) ';每位数
For I = x To 1 Step -1';D1
   a(I) = Mid(d3, I * 8 - 7, 8) ';每位数
   C1(I) = Val(1 & a(I)) - Val(B1(I)) - Val(1) + Val(jw) ';计算jia
   If Len(C1(I)) <= 8 Then
   jw = 0
   C1(I) = String(8 - Len(C1(I)), "0") & C1(I)
   Else
   jw = Left(C1(I), Len(C1(I)) - 8)
   End If
   E1(I) = Right(C1(I), 8)
   If Len(E1(I)) < 8 Then
   E1(I) = String(8 - Len(E1(I)), "0") & E1(I)
   Else
   E1(I) = E1(I)
   End If
   
    Next
    Next
    For r = 1 To x
    MPC = MPC & E1(r)
    If Len(MPC) > Len(D1) Then
    MPC = Mid(MPC, Len(MPC) - Len(D1) + 1)
    Else
    MPC = MPC
    End If
    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 If
   
End Function

   Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y, jw '两数长度
If qdqd0(D1) = "0" Then
MPC1 = D2
ElseIf qdqd0(D2) = "0" Then
MPC1 = D1
Else
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) \ 8: Y = Len(d4) \ 8
If 8 * x < Len(d3) Then
d3 = String(8 * x + 8 - Len(d3), "0") & d3
d4 = String(8 * Y + 8 - Len(d4), "0") & d4
x = x + 1: Y = Y + 1
Else
x = x: Y = Y
d3 = d3: d4 = d4
End If
Dim a() As String, B1() As String, C1() As String, E1() As String
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
For J = Y To 1 Step -1 'D2
jw = 0 '进位清0
B1(J) = Mid$(d4, J * 8 - 7, 8) '每位数
For I = x To 1 Step -1'D1
   a(I) = Mid$(d3, I * 8 - 7, 8) '每位数
   C1(I) = Val(a(I)) + Val(B1(I)) + Val(jw) '计算jia
   If Len(C1(I)) < 8 Then
   C1(I) = String(8 - Len(C1(I)), "0") & C1(I)
   Else
   C1(I) = C1(I)
   End If
   jw = Left(C1(I), Len(C1(I)) - 8)
   E1(I) = Right(C1(I), 8)
    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
   MPC1 = qdqd0(Trim(MPC1))
   End If
End Function

Public Function MBJC(D1 As String, D2 As String) As String ';bijiao
If Len(D1) <= 10 And Len(D2) <= 10 Then
If Val(D1) > Val(D2) Then
MBJC = 1
Else
If Val(D1) = Val(D2) Then
MBJC = 0
Else
MBJC = -1
End If
End If
Else

If Len(D1) > Len(D2) Then
MBJC = 1
Else
If Len(D1) < Len(D2) Then
MBJC = -1
Else
If Len(D1) = Len(D2) 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
End If
End If
End If
End Function
页: 1 2 [3]
查看完整版本: 几个快速小程序vb代码