107^101=9284564683560607824636349236036620084709403829405931331147437307957668341663495926748183799850251378750668211991763528582507888857722224558828540106085807378607424663142945342259084291023976378630973930107有205位

我就需要我说的那五个函数，如果能写给我将感激不尽。

前面都有了，其中除法程序是两种一种是快速的一种慢些仿手工的但可靠。另外有比较大小的函数，必须用到，而快速除法的程序还用到移动和添加小数点的程序。
供您参考试用，谢谢您沟通和指导！新年快乐！（快速程序总算弄好了，修改了移动小数点的位数，关键的一步，否则差距大就费力算不完了。）

[此贴子已经被作者于2021-2-17 23:42编辑过]

五个函数前面都有了，那个快速的除法还需要调试不知道还有没有问题，需要多次验证才能确定的，那个模仿手工计算的程序倒是可靠的，经过各种程序调用没有问题了，发现的问题都调整过来了。除了快速除法程序其他五个程序都能用，都是可靠的。

这5个函数都有了，那个快速的除法程序也能用了，但速度不快还不如模仿手工计算的快，因为调用的乘法是模仿手工计算的，本身不快，而且加了移动小数点的程序，比如10位的整数，为了保障精确度，移动了小数点相当于算到了几十位的乘法，实际加大了计算量，只有搞出来快速乘法程序速度才能提高。前面已经有一个模仿手工除法的采用试商方法的除法，计算几百位的速度也可以，所以，可以用前面那个程序。
谢谢沟通和指导！

如果可调用程序中的乘法程序换成快速乘法程序，这个除法程序的速度会大大提高，快速乘法程序有多快呢? 继续努力吧！

额，还差一个乘幂程序，是吧？我这里有个快速幂程序，送给你供参考！是计算整数的，不考虑带小数的，遇到底数带小数的可以移动小数点，计算完再移动回去，指数则必须是整数的！代码如下：

Private Sub Command1_Click() '快速幂程序
Dim a, b
a = Text1: b = Text2
If b = 1 Then
Text3 = a
ElseIf b = 0 Then
Text3 = 1
Else
a1 = a
Do While b > 1
s = Int(Log(b) / Log(2))
s1 = 0
Do While s1 < s
a = MbC(Trim(a), Trim(a))
s1 = s1 + 1
Loop
a2 = a
b = b - 2 ^ s
a = a1
If s2 > 0 Then
a3 = MbC(Trim(a3), Trim(a2))
Else
a3 = a2
End If
s2 = s2 + 1
Loop
If b = 1 Then
Text3 = MbC(Trim(a3), Trim(a1))
Else
Text3 = a3
End If
s3 = Len(Text3)
Text3 = Text3 & "有" & s3 & "位"
End If
End Sub

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

End Sub

Public Function MbC(D1 As String, D2 As String) As String '乘法
Dim x, Y '两数长度
x = Len(D1): Y = Len(D2)
Dim a() As Integer
ReDim a(1 To x + Y, 1 To Y)
Dim I, J, C1, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
C2 = Mid$(D2, J, 1) '每位数
For I = x To 1 Step -1 'D1
  C1 = Mid$(D1, I, 1) '每位数
  CJ = C1 * C2 + JW '计算乘积
  c = I + J: r = Y + 1 - J
  a(c, r) = CJ Mod 10 '本位
  JW = CJ \ 10 '进位
Next
a(c - 1, r) = JW
Next
Dim b() As Integer
ReDim b(1 To x + Y)
JW = 0
For I = x + Y To 1 Step -1
Bit = JW
For J = 1 To Y
  Bit = Bit + a(I, J)
Next
b(I) = Bit Mod 10
JW = Bit \ 10
Next
If b(1) > 0 Then
MbC = MbC & b(1)
Else
MbC = MbC
End If
For I = 2 To x + Y
MbC = MbC & b(I)
Next
End Function

2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601/
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801有2444位，用时548.1836秒（合9分钟多一点点，不必模仿手工除法快吗？）

下面传一下这个完整的程序代码，代码如下：


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
  Text3 = a1
  Else
  If 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), MbC4(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 & "有" & Len(a1) & "位，用时" & Timer - ts & "秒"
  Else
  Text3 = a1 & "/" & ja & "有" & Len(a1) & "位，用时" & Timer - ts & "秒"
  End If
  End If
  End Sub

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

  End Sub
  
   
        Public Function MbC4(D1 As String, D2 As String) As String '快速乘法
        Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
  Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
  Dim pi As Double, t As Double, tr1 As Double
        
  If Len(D1) + Len(D2) < 30000 Then
  MbC4 = MbC(Trim(D1), Trim(D2))
  Else
Dim xr() As Double, A As String
  A = Trim(D1)
  B = Trim(D2)
  
  x = Len(A) \ 4: Y = Len(B) \ 4
  A = String(Val(x * 4 + 4 - Len(A)), "0") & A
  B = String(Val(Y * 4 + 4 - Len(B)), "0") & B
  x = x + 1: Y = Y + 1
  sb1 = x + Y
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  A = String(Val(sb) * 4 - Len(A), "0") & A
  B = String(Val(sb) * 4 - Len(B), "0") & B
  
   ReDim x_(1 To sb): ReDim y_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(A, (sb - i1 + 1) * 4 - 3, 4): y_(i1) = Mid(B, (sb - i1 + 1) * 4 - 3, 4)
    If Len(x_(i1)) < 4 Then
    x_(i1) = String(4 - Len(x_(i1)), "0") & x_(i1)
    ElseIf Len(y_(i1)) < 4 Then
    y_(i1) = String(4 - Len(y_(i1)), "0") & y_(i1)
    Else
    x_(i1) = x_(i1): y_(i1) = y_(i1)
    End If
   
      Next
      ReDim xr(0 To (Len(A) - 4) \ 4): ReDim yr(0 To (Len(B) - 4) \ 4): ReDim zr(0 To (Len(B) - 4) \ 4)
      
       If Len(A) = 4 Then
  xr(0) = A: yr(0) = B
  Else
    Dim I As Long, J As Long, mn As Long, lh As Long, k As Long
    '位序倒置
n = sb '求数组大小，其值必须是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
   xr(I + 1) = x_(J + 1): yr(I + 1) = y_(J + 1)
    Next
    xr(0) = x_(1): xr(1) = x_(1 + sb / 2)
    yr(0) = y_(1): yr(1) = y_(1 + sb / 2)
  
     End If
  
  Dim xi(): Dim yi(): Dim zi()
  n = sb '求数组大小，其值必须是2的幂
m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
     
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
   zr(I) = xr(I) * yr(I) - xi(I) * yi(I): zi(I) = xr(I) * yi(I) + xi(I) * yr(I)
    zr(I) = Format(Val(zr(I)), "0.000000"): zi(I) = Format(Val(zi(I)), "0.000000")
  

      's = s & "/" & zr(I)
      's1 = s1 & "/" & zi(I)
      Next
      
       J = sb
     
       ReDim x_(1 To sb): ReDim y_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = zr(n1 - 1): y_(n1) = zi(n1 - 1)
         x_(n1) = Format(Val(x_(n1)), "0.000000"): y_(n1) = Format(Val(y_(n1)), "0.000000")
         
       Next
   
    '位序倒置
n = sb '求数组大小，其值必须是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

xr(I + 1) = x_(J + 1): yr(I + 1) = y_(J + 1)
    'js = js & "/" & x_(J + 1)
    'js1 = js1 & "/" & y_(J + 1)
    Next
    'sx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & js
    'sy1 = "/" & y_(1) & "/" & y_(1 + sb / 2) & js1
   xr(0) = x_(1): xr(1) = x_(1 + sb / 2)
   yr(0) = y_(1): yr(1) = y_(1 + sb / 2)
   
   
   ns = Len(A) \ 4: Jn = ns
  
      
  

  ReDim zr(0 To ns - 1)

  m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > ns
  ns = l / 2
  ReDim xi(ns - 1): ReDim yi(ns - 1): ReDim zi(ns - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = -1 * pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
      p = p + le
  Loop Until p > ns - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To ns - 1 '仅输出模
zr(I) = (xr(I) - yi(I)) / n
      zr(I) = Format(Val(zr(I) + 0.5), "0.000000")
     If InStr(zr(I), ".") = 0 Then
     s121 = zr(I)
     Else
     s121 = Left(zr(I), InStr(zr(I), ".") - 1)
      End If
      's0 = "/" & s121 & s0
      zr(I) = s121
      Next
      For i1 = 1 To Val(Jn - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = "0000"
      ElseIf Len(zr(i1)) < 4 Then
      zr(i1) = String(4 - Len(zr(i1)), "0") & zr(i1)
      Else
      zr(i1) = zr(i1)
      End If
      
      's5 = s5 & "/" & zr(i1)
      
      If i1 = 0 Then
      
      s6 = Val(Left(zr(i1), Len(zr(i1)) - 4))
      If Len(s6) < 4 Then
      s6 = String(4 - Len(s6), "0") & s6
      Else
      s6 = s6
      End If
      s8 = Right(zr(i1), 4)
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = Val(zr(i1)) + Val(s6)
    If Len(s7) = 4 Or Len(s7) = 8 Or Len(s7) = 12 Then
          s7 = s7
          Else
          s7 = String(12 - Len(s7), "0") & s7
         End If
      s10 = Right(s7, 4)
      s11 = s10 & s11
      If Len(s7) < 4 Then
      s7 = String(4 - Len(s7), "0") & s7
      ElseIf Len(s7) = 4 Then
      s6 = "0000"
      Else
      s7 = s7
      s6 = Val(Left(s7, Len(s7) - 4))
      End If
      Else
      s6 = s6
      End If
     
      Next
      s9 = s6 & s11 & s8
     
   
   s9 = qdqd0(Trim(s9))
   
     's2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     
     's3 = nifft(Trim(sx1), Trim(sy1), Trim(sb1))
      MbC4 = s9
      End If
  End Function

  
  
  
  
  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 = MbC4(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&

   ' 按列法计算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

  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) \ 8: Y = Len(D4) \ 8
  If Len(D3) > 8 * x 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, 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
     JW = C1(I) \ 10 ^ 8
     E1(I) = C1(I) Mod 10 ^ 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 Function
   Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
  Dim x, Y, JW '两数长度

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 = qqdl(Trim(MPC1))
  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



'符号运算程序
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 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

'去前导0的程序
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

'带符号的比较大小程序
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 mbc6(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 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



'比较大小的程序
Public Function MBJC1(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

[此贴子已经被作者于2021-4-17 23:53编辑过]

这个有许多可调用程序，其实都是没有用的，程序中没有用到，只是为了进一步升级，继续提高速度而收集在一起，说不定以后能用上。