2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601用时0.9394531秒，有4888位(这是利用快速傅里叶变换的乘法结果，改进了一下，5位一组，速度稍有提高，但仍然不如前面的模仿手工计算的快速乘法)

这个代码如下：
Private Sub Command1_Click()
Dim m, n
m = Trim(Text1): n = Trim(Text2)
ts = Timer
c = MbC4(Trim(m), Trim(n))
Text3 = c & "用时" & Timer - ts & "秒，有" & Len(c) & "位"
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
        
  
Dim xr() As Double, a As String
  a = Trim(D1)
  B = Trim(D2)
  
  X = Len(a) \ 5: Y = Len(B) \ 5
  a = String(Val(X * 5 + 5 - Len(a)), "0") & a
  B = String(Val(Y * 5 + 5 - 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) * 5 - Len(a), "0") & a
  B = String(Val(sb) * 5 - 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) * 5 - 4, 5): y_(i1) = Mid(B, (sb - i1 + 1) * 5 - 4, 5)
    If Len(x_(i1)) < 5 Then
    x_(i1) = String(5 - Len(x_(i1)), "0") & x_(i1)
    ElseIf Len(y_(i1)) < 5 Then
    y_(i1) = String(5 - Len(y_(i1)), "0") & y_(i1)
    Else
    x_(i1) = x_(i1): y_(i1) = y_(i1)
    End If
   
      Next
      ReDim xr(0 To (Len(a) - 5) \ 5): ReDim yr(0 To (Len(B) - 5) \ 5): ReDim zr(0 To (Len(B) - 5) \ 5)
      
       If Len(a) = 5 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) \ 5: 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) = "00000"
      ElseIf Len(zr(i1)) < 5 Then
      zr(i1) = String(5 - 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)) - 5))
      If Len(s6) < 5 Then
      s6 = String(5 - Len(s6), "0") & s6
      Else
      s6 = s6
      End If
      s8 = Right(zr(i1), 5)
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = Val(zr(i1)) + Val(s6)
    If Len(s7) = 5 Or Len(s7) = 10 Or Len(s7) = 15 Then
          s7 = s7
          Else
          s7 = String(20 - Len(s7), "0") & s7
         End If
      s10 = Right(s7, 5)
      s11 = s10 & s11
      If Len(s7) < 5 Then
      s7 = String(5 - Len(s7), "0") & s7
      ElseIf Len(s7) = 5 Then
      s6 = "00000"
      Else
      s7 = s7
      s6 = Val(Left(s7, Len(s7) - 5))
      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 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

[此贴子已经被作者于2021-5-4 18:41编辑过]

7172463269826462171528525227724894034214868966993605795401948124722087997342143358371455108964150545128907248526343196455641573509751354673861557821110693231777877738015812129161714061189179959717148156972438006245711375491637996368054355662274712424986912135083307535204835752100527089372858343068979871404409740751212288162364580340051030336669437742592243358179513860552191185265379861524597999525415656854787911581643398207658315370562159727183489341082919000873799051151043947664730614606995331479395199806790880383623001985260201859351553733798110323146855143033755798433086479488024524618236189650830082641092858321608765095677671296332855383698658513841618432462514767301509015302731887426449020324508457305854743150812148135681998160759231340593224787524059384993567619253642859738374890522751502722301228640973352385535814528059287908278674678352643221455078097708537386230468632692143543786079089278143231331448551012324709811279702452779256184630920739523413422282624035439915227985252545794326379126775078358185074208637164548385049952343933304537250581118807518766053939393481540287533027802322405590412993878611099596612132868370166415773181601154351447449360821364030895301897439991811626252222800042408837799445748876986689983744267954539975623901497977921404672456088365607147517753334119523085306549029501450784349931681757118493080278423158884618389416751863515799501941931299333482860034175574234687366084034854559860406380515922622731215797937947749347523567616361602120568917837553302958455697473044355271553097193939898199130578212161450820530733402948944817740996785663578468527435799222211621687841330657355269886610809724657106599734412672509267528377383850891990213998928910925665771135271178329415173122279497587450094043452968217137897325537655382191951751305922520305745720481516125474084463651538358435467578314496534799610440729366870223201955669253868969728058316618723047893958806793103141691041934291198205584987981081000108093858653439624897454612814469707610638127291418381351191694294777021231948012520106211264528527924444201382244571278473214765325480705119868390993533790074524744095675902347116176374826615934187667836147801248099347800023505688743794273915955274979733822944679464000508774509390349906781765163794451106428726498478530824886867499104246201491752880954757001517163612506498931595524274363029567180050754501432532286684708062072343197640125970583368911454340495069475260464330960780880200756901690402890214648943068478380757589861100818684623184349329031152871503812892139965016318354450639572431318054475101906966356246728290357750255900892206636706659073423666601520176669794618490222246109251969096246673833325909200541908647265810778433581200166738963648865628467965987974276129559867820182461324727175812909248560556153989070551651206916397043015129112324174041078381598687340367330369743574483768123513914466078688385552657957466373141833312470005872038158158558758597782287039757518156507558332909095180665881503900399254393925538499082517233770693477475440628379280827399682320040292147212671478850267113144256467717832789836095684233795606474628605577407950893979220730884373604393712239399619598622515105407684769318956407495911888144725372198319167914080204643210431914238821762306355036590446232568753016880799686685880210761285646606345578580056778051890680006982633074396045998096007046814297317508472091232768681594848779768724106961419347315786049071217250606391912412090036387359478549697004116901877456389276560046168633296499987754935871886741805805544288336626689145248219392479520665544572592654825874224723479880277722687977622479652630381460400253566835128569128126839849213424501027798623052330552639340014466433204854284282451838267652596510117073421554349769115596747847222786403991672125861002797993917039353677197561761018603077826216853034619545722932609155001960887797757724784083641663152934067672560173435725465409431333528091135523120222385280011570777644633992350683777567415457830142061356335821132623807179012101446605207533723888496145283691343028263101524024846536249138277962355381236115191250993587394690915625304012223449766194430885987517644469628964169109557807580762078537823980480277465642584796467360214177043602577120889280685824649388496001273597116159134970313980353087497406685979214581267102484657541875734018573130363674965905476673163481843821632051283681039720334533765017564509447055586120874529359775805844927319441709905022001704116387838005555153895216897265575940773948153176057832585460429745756094209528141488349976396674145584278724158836079117395297220622272613076439797697250956341920663130800734933155473346047738298666918898902058007968877485494163402560976541434704853172824135465265265413974659965992895056898571176505487405592027170864616186946549268484945297743480501600120064292645208037740939399240094229556634953081272586550404921251625234389912469589310281012901392380576054483238327215960879621215969418846522922054542058918325244657436478923637305716604682937562502625439542890870560297001951641986789624288562889846686525163088338471193186909768839469313807434287938259075089209910815237602035006864287774116054689067777229371270478665958455578247242113942197143505270008270270882191459688500066171521085054637377654252805754437567172842547938504092900808035624181824913689212947749777436293373997711125153064037803130649030656558546371288595296468051919653790009777109517042131035126573157883183656149031966290078048334686709613718875861993309644523724063515318637150743743389819818443552464423324971361456328433637001544654164638134029593641252649445564245102383007994865579077339457095651502941609117808906309223556024161286929108818191092639537820354261080758077666630753705679538620750240666605592530730238594235539574877759961712126221403282110319210039096970244934331283753007521745745837118120875705449296773432071049524935985944109558437494014526628545805285283211428212254815968453350353270667791149002454020746551663288384513504477866563520997609007704638752734240019484187769074642477074635474178236636866384721352427137750376744613001123164665522329698946864898915127542184529485587658494587744364754108361832698602920926798129076766271689152063216892000068702714408279505019745577786412160670706124504985662713657321905320058533322793579237307804061839083228241436729193118794125128602094745055040576711788450457579614174565175802897167080710639994745840408397188506013885908234200079470657560761093726188202968121735561672223506544407698071001104638286697863716911974871887889137352956177408235640187026335370180204269652496414622509246371913138867876466852915702002493457796630152391077246573798902025599992921947798890245930826255604543179370599273579602413417025291509137312565324651045766230943157633671851484144506416775604281483649665758671646087878710299223648600430794245286634276337844861170064580136723171347269810295795858398334220900459465680922702870972535103576876292907307652387534960191148834056753451657660931145515183543034393594453522937133734797355509943645187648731036090794950906104283431878826206307827524070028872299576965917050394234259986403377998509485079981363227077920026415618622428351304948072774838856801910366262559417442075232876162498709886882802124652312784435273507112770600208831184523646975165214379848407565171174246809997646009632924501230290592771311174549485322280542389123380362520652882111312033936289163788141960823931696888562106170237706550474284332740770252213900167894107284777482550350071361367151033525557171242907760562805679088739980478417471947819864720913692627336875658905474566774039096016299963861473601740086381354257179117749979010998112356352808189165832640207384776942252523357810039236078254183515529059874835125061234394074924909132255049783257541224053548198808652934695191418942834042371211524505976359110862030354610440635466142233137032127828857341531945816347930334509783514826135049690966965590328180073893837602188523301252123322723686120745275718705335983789003879497358018233759586456552862045742698107466630548973174919196570904489890564814069316083928253565097210010972987364689613782060247756229844584102377898827698947656763349306029039082478169225459931807461582437866510644539950728909670405185406776395849139556079466224657039622466467248175545823623111884112843786943196766907877471459634386322517853379671635861176446902694845586618133960389483456792263969375098395117758301586552554735290557282182649471723233085316948575654535258764959248191371622912245057971788968465050758911262576841267180636859779757898070212042118711333384216610181492870803869468282666126519808348146096589922650048641772202198072403546045272458781263186975049222383319870833843327375945414614154247992477644715054102005628243992111786180131664024016803330080223139821644587273437441338849555910477687563186510842007994149483363916523106835536022015378348641756245301023218771922044525978889328011515196392351153367647898428790542145817468347061491199973362848006838675577998841359685950026995771734056969750046174178343024201957430428174909217623707800454587541547999372447814554325540261532995290859332208048663519065389569542084421397802194571699591730237799757313714472333153018836276577894871710374936427805210334149251476143194011904103580927705512657445792637448210801981406325898853914731016758315659836542449366051395779886791126380622850691083405899521557705689988227787187036384654263022977011149854400284754958678411636633870582670219621470547411288183081931679714837078992548282323330288773323468937974805019102283375562950349861921150037994035660525472554512367270458369512316693424357275110365137080817513123195148755802178179447803099975134439746839174283238011413458411062894320960126845861170742217107400439529873590483426646151584669746270815795201用时1.933594秒，有9775位（这也是该程序算的，速度有所提高，仍然不如前面的模仿手工计算的快速乘法，如何优化？）

学习学习

'超大整数的加减乘除运算及x进制转换

Option Explicit

 Public Function IIf(ByVal blnExp, vtTrue, vtFalse)
     If blnExp Then
         IIf = vtTrue
     Else
         IIf = vtFalse
     End If
 End Function

 Public Function ChangeType(vtData, vtType)
     Dim ret
     Select Case vtType
     Case vbEmpty
     Case vbNull
         ret = Null
     Case vbInteger
         ret = ChangeType(vtData, vbDouble)
         If ret >= -32768 And ret <= 32767 Then
             ret = CInt(ret)
         Else
             ret = 0
         End If
     Case vbLong
         ret = ChangeType(vtData, vbDouble)
         If ret >= -2147483648 And ret <= 2147483647 Then
             ret = CLng(ret)
         Else
             ret = CLng(0)
         End If
     Case vbSingle
         If IsNumeric(vtData) Then
             ret = CSng(vtData)
         ElseIf VarType(vtData) = vbDecimal Then
             ret = CSng(vtData)
         Else
             ret = CSng(0)
         End If
     Case vbDouble
         If IsNumeric(vtData) Then
             ret = CDbl(vtData)
         ElseIf VarType(vtData) = vbDecimal Then
             ret = CDbl(vtData)
         Else
             ret = CDbl(0)
         End If
     Case vbCurrency
         ret = ChangeType(vtData, vbDouble)
         If ret >= -922337203685477.5808 And ret <= 922337203685477.5807 Then
             ret = CCur(ret)
         Else
             ret = CCur(0)
         End If
     Case vbDate
         If IsDate(vtData) Then
             ret = CDate(vtData)
         End If
     Case vbString
         If Not IsNull(vtData) Then
             ret = CStr(vtData)
         Else
             ret = Empty
         End If
     Case vbBoolean
         ret = ChangeType(vtData, vbDouble)
         ret = CBool(Not ret = 0)
     Case vbByte
         ret = ChangeType(vtData, vbDouble)
         If ret >= 0 And ret <= 255 Then
             ret = CByte(ret)
         Else
             ret = CByte(0)
         End If
     Case Else
         If VarType(vtData) = vbObject Then
             Set ret = vtData
         Else
             ret = vtData
         End If
     End Select
     ChangeType = ret
 End Function

 Public Function atos(vtData)
     atos = ChangeType(vtData, vbString)
 End Function

 Public Function atoi(vtData)
     atoi = ChangeType(vtData, vbInteger)
 End Function

 Public Function atol(vtData)
     atol = ChangeType(vtData, vbLong)
 End Function

 Public Function atof(vtData)
     atof = ChangeType(vtData, vbDouble)
 End Function

 Class ImplNumber
 Public Function MyFormat(ByVal n)
     Dim p, r, l, i
     p = atos(n)
     l = Len(p)
     ReDim r(l - 1)
     For i = 1 To l
         r(i - 1) = (Asc(Mid(p, i, 1)) And &HFF) - 48
         If r(i - 1) < 0 Or r(i - 1) > 10 Then
             Err.Raise vbObjectError + 1, "ImplNumber.Format", "第" & (i - 1) & "位字符(" & Chr(r(i - 1) + 48) & ")非数字"
         End if
     Next
     MyFormat = r
 End Function

 Public Function MyFix(ByVal n)
     Dim p
     p = atos(n)
     Do While Left(p, 1) = "0"
         p = Mid(p, 2)
     Loop
     If p = "" Then p = "0"
     MyFix = p
 End Function

 Private Function Compare(ByVal n1, ByVal n2)
     Dim p1, p2
     Dim l1, l2
     Dim i, i1, i2
     p1 = atos(n1)
     p2 = atos(n2)
     l1 = Len(p1)
     l2 = Len(p2)
     If l1 > l2 Then
         Compare = 1
     ElseIf l1 < l2 Then
         Compare = -1
     ElseIf p1 = p2 Then
         Compare = 0
     Else
         For i = 1 To l1 Step 8
             i1 = CLng(Mid(p1, i, 8))
             i2 = CLng(Mid(p2, i, 8))
             If i1 > i2 Then
                 Compare = 1
                 Exit For
             ElseIf i1 < i2 Then
                 Compare = -1
                 Exit For
             End If
         Next
     End If
 End Function

 Private Function MyNumber(ByVal l)
     Dim r, i
     ReDim r(l)
     For i = 0 To l
         r(i) = 0
     Next
     MyNumber = r
 End Function

 Private Function MyAdd(ByVal n1, ByVal n2)
     Dim p1, p2, p3
     Dim l1, l2, l3
     Dim i, t
     p1 = MyFormat(n1)
     p2 = MyFormat(n2)
     l1 = UBound(p1)
     l2 = UBound(p2)
     l3 = IIf(l1 > l2, l1, l2) + 1
     p3 = MyNumber(l3)
     t = 0
     For i = 0 To l3
         If l1 - i >= 0 Then t = t + p1(l1 - i)
         If l2 - i >= 0 Then t = t + p2(l2 - i)
         p3(l3 - i) = IIf(t > 9, t - 10, t)
         t = IIf(t > 9, 1, 0)
     Next
     MyAdd = MyFix(Join(p3, ""))
     Erase p1
     Erase p2
     Erase p3
 End Function

 Private Function MySubtract(ByVal n1, ByVal n2)
     Dim p1, p2, p3, sign
     Dim i, t, l1, l2, l3
     Select Case Compare(n1, n2)
     Case -1
         p1 = MyFormat(n2)
         p2 = MyFormat(n1)
         sign = "-"
     Case 0
         MySubtract = "0"
         Exit Function
     Case 1
         p1 = MyFormat(n1)
         p2 = MyFormat(n2)
     End Select
     l1 = UBound(p1)
     l2 = UBound(p2)
     l3 = l1
     p3 = MyNumber(l3)
     t = 0
     For i = 0 To l3
        If l1 - i >= 0 Then t = p1(l1 - i) - t
        If l2 - i >= 0 Then t = t - p2(l2 - i)
        p3(l3 - i) = IIf(t < 0, t + 10, t)
        t = IIf(t < 0, 1, 0)
     Next
     MySubtract = sign & MyFix(Join(p3, ""))
     Erase p1
     Erase p2
     Erase p3
 End Function

 '加法
Public Function Add(ByVal n1, ByVal n2)
     Dim s1, s2
     Dim p1, p2
     p1 = MyFix(n1)
     p2 = MyFix(n2)
     s1 = Left(p1, 1)
     s2 = Left(p2, 1)
     If s1 = "-" Then p1 = MyFix(Mid(p1, 2))
     If s2 = "-" Then p2 = MyFix(Mid(p2, 2))
     If s1 = "-" Then
         If s2 = "-" Then
             Add = "-" & MyAdd(p1, p2)
         Else
             Add = MySubstract(p2, p1)
         End If
     Else
         If s2 = "-" Then
             Add = MySubtract(p1, p2)
         Else
             Add = MyAdd(p1, p2)
         End If
     End If
 End Function

 '减法
Public Function Subtract(ByVal n1, ByVal n2)
     Dim s1, s2
     Dim p1, p2
     p1 = MyFix(n1)
     p2 = MyFix(n2)
     s1 = Left(p1, 1)
     s2 = Left(p2, 1)
     If s1 = "-" Then p1 = MyFix(Mid(p1, 2))
     If s2 = "-" Then p2 = MyFix(Mid(p2, 2))
     If s1 = "-" Then
         If s2 = "-" Then
             Subtract = MySubstract(p2, p1)
         Else
             Subtract = "-" & MyAdd(p1, p2)
         End If
     Else
         If s2 = "-" Then
             Subtract = MyAdd(p1, p2)
         Else
             Subtract = MySubtract(p1, p2)
         End If
     End If
 End Function

 Private Function MyMultiply(ByVal n1, ByVal n2)
     Dim p1, p2, p3, p4
     Dim l1, l2, l3
     Dim i, k, t
     If Compare(n1, n2) = 1 Then
         p1 = MyFormat(n2)
         p2 = MyFormat(n1)
     Else
         p1 = MyFormat(n1)
         p2 = MyFormat(n2)
     End If
     l1 = UBound(p1)
     l2 = UBound(p2)
     p4 = "0"
     For i = 0 To l1
         l3 = l2 + i + 1
         p3 = MyNumber(l3)
         t = 0
         For k = 0 To l2
             t = t + p1(l1 - i) * p2(l2 - k)
             p3(l3 - i - k) = IIf(t > 9, (t Mod 10), t)
             t = IIf(t > 9, t / 10, 0)
         Next
         If t > 0 Then
             p3(l3 - i - k) = t
         End If
         p4 = MyAdd(p4, MyFix(Join(p3, "")))
         Erase p3
     Next
     MyMultiply = p4
     Erase p1
     Erase p2
 End Function

 '乘法
Public Function Multiply(ByVal n1, ByVal n2)
     Dim s1, s2
     Dim p1, p2
     p1 = MyFix(n1)
     p2 = MyFix(n2)
     s1 = Left(p1, 1)
     s2 = Left(p2, 1)
     If s1 = "-" Then p1 = MyFix(Mid(p1, 2))
     If s2 = "-" Then p2 = MyFix(Mid(p2, 2))
     If p1 = "0" Or p2 = "0" Then
         Multiply = "0"
     ElseIf s1 = "-" Then
         If s2 = "-" Then
             Multiply = MyMultiply(p1, p2)
         Else
             Multiply = "-" & MyMultiply(p1, p2)
         End If
     Else
         If s2 = "-" Then
             Multiply = "-" & MyMultiply(p1, p2)
         Else
             Multiply = MyMultiply(p1, p2)
         End If
     End If
 End Function

 Private Function MyDiv(ByVal n1, ByVal n2)
     Dim p(1), n3, i
     n3 = MySubtract(n1, n2)
     i = 1
     Do While Compare(n3, n2) <> -1
         n3 = MySubtract(n3, n2)
         i = i + 1
     Loop
     p(0) = i
     p(1) = n3
     MyDiv = p
 End Function

 Private Function MyDivision(ByVal n1, ByVal n2, ByVal decimal, ByVal sign)
     Dim p1, p2, p3(1), p4, p5
     Dim i, cmp, l1, l2, lx
     If decimal > 0 Then
         p1 = n1 & String(decimal, "0")
     Else
         p1 = n1
     End If
     p2 = n2
     cmp = Compare(p1, p2)
     If cmp = -1 Then
         p3(0) = 0
         p3(1) = n1
         MyDivision = p3
         Exit Function
     End If
     If cmp = 0 Then
         If decimal > 0 Then
             p3(0) = sign & "0." & String(decimal - 1, "0") & 1
             p3(1) = n1
         Else
             p3(0) = sign & "1"
             p3(1) = 0
         End If
         MyDivision = p3
         Exit Function
     End If
     l1 = Len(p1)
     l2 = Len(p2)
     lx = Len(n1)
     p4 = Mid(p1, 1, l2)
     i = l2
     p3(0) = sign
     If decimal > 0 And i > lx Then
         p3(0) = p3(0) & "." & String(i - lx - 1, "0")
     End If
     Do While i <= l1
         If Compare(p4, p2) <> -1 Then
             p5 = MyDiv(p4, p2)
             p4 = p5(1)
             p3(0) = p3(0) & p5(0)
         ElseIf i = l1 Then
             If i = lx Then p3(1) = MyFix(p4)
             Exit Do
         Else
             If i = lx Then
                 p3(1) = MyFix(p4)
                 If decimal > 0 Then p3(0) = p3(0) & "."
             End If
             i = i + 1
             p4 = MyFix(p4 & Mid(p1, i, 1))
             If Compare(p4, p2) = -1 Then p3(0) = p3(0) & "0"
         End If
     Loop
     MyDivision = p3
 End Function

 '除法
'decimal = 小数点后的位数
'函数返回拥有两个元素的数组
'元素0 = 商
'元素1 = 余数
Public Function Division(ByVal n1, ByVal n2, ByVal decimal)
     Dim s1, s2
     Dim p1, p2
     p1 = MyFix(n1)
     p2 = MyFix(n2)
     s1 = Left(p1, 1)
     s2 = Left(p2, 1)
     If s1 = "-" Then p1 = MyFix(Mid(p1, 2))
     If s2 = "-" Then p2 = MyFix(Mid(p2, 2))
     If p1 = "0" Then
         Division = Array(0, 0)
     ElseIf p2 = "0" Then
         Err.Raise vbObjectError + 1, "ImplNumber.Division", "被零除"
     ElseIf s1 = "-" Then
         If s2 = "-" Then
             Division = MyDivision(p1, p2, decimal, "")
         Else
             Division = MyDivision(p1, p2, decimal, "-")
         End If
     Else
         If s2 = "-" Then
             Division = MyDivision(p1, p2, decimal, "-")
         Else
             Division = MyDivision(p1, p2, decimal, "")
         End If
     End If
 End Function

 '将一个10进制整数进行(2 - 36)进制的转换
Public Function BaseX(ByVal n, ByVal x)
     Dim s, i, p
     If x < 2 Then
         Err.Raise vbObjectError + 1, "ImplNumber.BaseX", "错误的进制"
     End If
     If Compare(n, "0") = 1 Then
         p = Division(n, x, 0)
         s = s & BaseX(p(0), x)
         i = CInt(p(1))
         If i < 10 Then
             s = s & i
         Else
             s = s & Chr(i + 55)
         End If
     End If
     BaseX = s
 End Function

 '将一个(2 - 36)进制的字符转换成10进制的整数
Public Function ConvertX(ByVal s, ByVal x)
     Dim i
     Dim n, p, t
     If x < 2 Then
         Err.Raise vbObjectError + 1, "ImplNumber.ConvertX", "错误的进制"
     End If
     n = 0
     p = 1
     For i = Len(s) To 1 Step -1
         t = Asc(Mid(s, i, 1)) And &HFF
         If t >= 48 And t <= 57 Then
             t = t - 48
         ElseIf t >= 65 And t < 55 + x And t <= 90 Then
             t = t - 55
         ElseIf t >= 97 And t < 87 + x And t <= 122 Then
             t = t - 87
         Else
             Err.Raise vbObjectError + 1, "ImplNumber.ConvertX", "错误的进制字符串"
         End If
         n = Add(n, Multiply(t, p))
         p = Multiply(p, x)
     Next
     ConvertX = n
 End Function
 End Class

 '范例
Dim num, i, x
 Set num = New ImplNumber
 WScript.Echo num.Add(784921795923989, 5215632421426)
 WScript.Echo num.Subtract(784921795923989, 5215632421426)
 WScript.Echo num.Multiply(784921795923989, 5215632421426)
 WScript.Echo Join(num.Division(784921795923989, 5215632421426, 12), " - ")
 For i = 2 To 36
     x = num.BaseX(784921795923989, i)
     WScript.Echo "Base" & i & "(" & num.ConvertX(x, i) & ") = " & x
 Next
 Set num = Nothing

这个全是在网上复制的，不知道能不能运行，谢谢各位老师的指导和帮助！

还在研究算法速度？不如去学快速算法，或许是个方向。

刚才看到回复迟了深表歉意，请谅解！

是的，程序运行速度一直是我的难题可能是到了VB程序设计的天花板了？咋回事呢？VB程序设计即使用了傅立叶快速变换的乘法程序速度也是不快，主要是VB程序设计有效数字仅仅15位，不能发挥傅立叶变换的作用，因为变换的时候一位数字变换后的数值的整数部分就有3位的时候，由于有效数字只有15位则最多能把4位或者5位的z数字当做一位来用，而利用模仿手工计算的则可以把8位的字符串当一位用，模仿手工的乘法比傅立叶变换的乘法速度还要快了。

可能其他语言的软件适合傅立叶快速变换的乘法程序，比如VC语言可能就行，以后想学习一下VC。
还有mathematica据说也是很快的可以计算大整数大数据的，好象也是基于VC的程序，我也不会也没有这个软件。

向老师学习！

[此贴子已经被作者于2021-11-18 18:56编辑过]

过谦了，看来真心下功夫研究这题，哪里搜的分治资料等！
灵感可遇而不可求，刚写了开任意方的代码完全来自灵感，有兴趣的话可看我CSDN博客，写好了就想起这题目来了；
不过想要告诉你的是一个经验，从蛋骗鸡程序设计里面看到的现象，运算符的使用影响速度，如使用>和>=运算符后面的速度比较慢，因此同理要注意到。

谢谢关注和指导！分治法的资料都是网上搜索的，有的网站打不开需要收费，有的是开放的，基本方法一般是开放的，代码就可能是会收费的，我的方法仅仅供参考不收费，哈哈！
您的经验和程序很好，我缺乏这个资料和技术，谢谢！