大整数的加减乘除快速程序（可调用程序）

ysr

Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
  Dim X, Y, JW '两数长度
D1 = qqdl(Trim(D1)): D2 = qqdl(Trim(D2))
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 MPC(D1 As String, D2 As String) As String ';jianfaqi
  Dim X, Y ';两数长度
  D1 = qqdl(Trim(D1)): D2 = qqdl(Trim(D2))
  If qqdl(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 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


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
Do While MBJC(D1, D2) >= 0
S1 = S1 + 1
D1 = MPC(D1, D2)
Loop
If D1 = 0 Then
MCC1 = S1
Else
    MCC1 = S1 & "/" & D1
End If
ElseIf Len(D1) - Len(D2) >= 1 And Len(D1) - Len(D2) <= 4 Then
ls = Len(D1) - Len(D2)
Dim la(), lb()
ReDim la(1 To ls + 1)
ReDim lb(1)
lb(1) = Mid(D2, 1, 1)
For i1 = 1 To ls + 1
la(i1) = Mid(D1, i1, 1)
jws1 = jws1 & la(i1)
Next
jss1 = Val(jws1) \ Val(lb(1))
Do While MBJC(MbC(Trim(D2), Val(jss1)), D1) > 0
jss1 = jss1 - 1
Loop

If MPC(Trim(D1), MbC(Trim(D2), Val(jss1))) = 0 Then
MCC1 = Val(jss1)
Else
MCC1 = Val(jss1) & "/" & MPC(Trim(D1), MbC(Trim(D2), Val(jss1)))
End If

    Else
    If Len(D2) < 9 Then
     MCC1 = MCC(D1, D2)
     Else
    Dim X, Y ';定义分段长度
   
    X = Len(D1) \ 4: Y = Len(D2) \ 4
    If Len(D1) > 4 * X Then
    X = X + 1
    D1 = String(4 * X - Len(D1), "0") & D1
    ElseIf Len(D2) > 4 * Y Then
    Y = Y + 1
    D2 = String(4 * Y - Len(D2), "0") & D2
    Else
    D1 = String(4 * X - Len(D1), "0") & D1
    D2 = String(4 * Y - Len(D2), "0") & D2
    End If
  X = Len(D1) \ 4: Y = Len(D2) \ 4
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 * 4 - 3, 4)
  Next
  For j = 1 To Y
  B(j) = Mid(D2, j * 4 - 3, 4)
  jws = jws & A(j)
  Next
If Len(qqdl(Trim(jws))) <= Len(qqdl(D2)) Then
  jcc = Val(Left(qqdl(A(1) & A(2)), 2)) \ Val(Left(qqdl(B(1) & B(2)), 2))
  Else
  jcc = Val(Left(qqdl(A(1) & A(2)), 2 + Len(qqdl(Trim(jws))) - Len(qqdl(D2)))) \ Val(Left(qqdl(B(1) & B(2)), 2))
  End If

  jss = MbC(Trim(jcc), D2)
  
   
      Do While MBJC(Trim(jws), Trim(jss)) = -1
      jcc = jcc - 1
      jss = MbC(Trim(jcc), D2)
      Loop
  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) = "0000"
       Else
       If Len(qqdl(JW & A(s + Y))) = Len(qqdl(D2)) Then
  jwc = Val(Left(qqdl(JW & A(s + Y)), 4)) \ Val(Left(qqdl(B(1) & B(2)), 4))
  Else
  If Len(qqdl(JW & A(s + Y))) <= Len(qqdl(D2)) Then
  jwc = Val(Left(qqdl(JW & A(s + Y)), 4)) \ Val(Left(qqdl(B(1) & B(2)), 4))
  Else
  jwc = Val(Left(qqdl(JW & A(s + Y)), 4 + Len(qqdl(JW & A(s + Y))) - Len(qqdl(D2)))) / Val(Left(qqdl(B(1) & B(2)), 4))
  jwc = Format(Val(jwc), "0.000000")
  If InStr(jwc, ".") = 0 Then
  jwc = jwc
  Else
  jwc = Left(jwc, InStr(jwc, ".") - 1)
  End If
  End If
  End If
     c(s) = jwc
         End If
       jsw = MbC(Trim(c(s)), Trim(D2))
       Do While MBJC(JW & A(s + Y), Trim(jsw)) = -1
      c(s) = c(s) - 1
      jsw = MbC(Trim(c(s)), D2)
      Loop
     JW = MPC(JW & A(s + Y), MbC(Val(c(s)), D2))
     Do While MBJC(Trim(JW), Trim(D2)) >= 0
     jwc1 = jwc1 + 1
     JW = MPC(Trim(JW), Trim(D2))
     Loop
     c(s) = Val(c(s) + jwc1)
    c(s) = Right(100000000 + Val(c(s)), 4)
     
    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

ysr

73425633894622870812912264279427304662415407498217399761627450589750429468816261632146658967160832384997092708273473~73425633894622870812912264279427304662415407498217399761627450589750429468816261632146658967160832384997092708273673之间的素数有1个(用时1782.273秒 )：
73425633894622870812912264279427304662415407498217399761627450589750429468816261632146658967160832384997092708273663   
终于找到了一个素数（有116位）