还有一种情况有时候不准呢，咋回事，咋就弄准了？
111111111111111111111111*111111=01234566666666666666666666666666666666665754330（不对了），应该是：01234566666666666666666666666666666666666664321.
11111111111111111111111111111*111111=012335666656666666666666666666666666666666666666666666666666666654311（不对了），应该是：012345666666666666666666666666666666666666666666666666666666666654321.

咋回事呢，咋总是有一些算不准呢？

[此贴子已经被作者于2021-3-18 14:21编辑过]

改了一下，还是有不对的，代码如下：

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
sb1 = Len(a) + Len(b)
sb2 = Log(sb1) / Log(2)
If InStr(sb2, ".") = 0 Then
sb2 = sb2
Else
sb2 = Int(sb2) + 1
End If
sb = 2 ^ sb2
Print sb
If Len(a) = Len(b) And 2 ^ (Int(Log(Len(a)) / Log(2))) = Len(a) Then
  a = String(Val(sb) - Len(a), "0") & a
b = String(Val(sb) - Len(b), "0") & b
a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
Else

a = String(Val(sb) - Len(a), "0") & a
b = String(Val(sb) - Len(b), "0") & b
a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
End If
ReDim xr(0 To Len(a) - 1): ReDim yr(0 To Len(b) - 1): ReDim zr(0 To Len(b) - 1)
For i1 = 0 To Len(a) - 1
xr(i1) = Mid(a, i1 + 1, 1)
yr(i1) = Mid(b, i1 + 1, 1)

   Next
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 xi(): Dim yi(): Dim zi()
n = Len(a) '求数组大小，其值必须是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
   
    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)
    If InStr(zr(i), ".") = 0 Then
    zr(i) = zr(i)
    Else
    a1 = Left(zr(i), InStr(zr(i), ".") - 1)
    b1 = Mid(zr(i), InStr(zr(i), "."), 5)
    zr(i) = a1 & b1
    End If

    s = s & "/" & zr(i)
    s1 = s1 & "/" & zi(i)
    Next
   s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
   s3 = nifft(Trim(s), Trim(s1), Trim(sb1))
    Text2 = s2
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Form1.Cls
End Sub

Private Function nifft(sa As String, sb As String, sb1 As String) As String
Dim l As Long, le As Long, le1 As Long, j 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 xi(): Dim yi(): Dim zi()
Dim xr(), yr(), zr()
s2 = Split(sa, "/")
s3 = Split(sb, "/")
    j = UBound(s2)
    n = j
   For k = 1 To j
       n1 = n1 + 1
        ReDim Preserve xr(0 To n1 - 1)
        ReDim Preserve yr(0 To n1 - 1)
       xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
     Next
   

ReDim zr(0 To j - 1)

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 = -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
   
    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) - yi(i)) / n
    If InStr(zr(i), ".") = 0 Then
    zr(i) = zr(i)
    Else
    a1 = Left(zr(i), InStr(zr(i), ".") - 1)
    b1 = Mid(zr(i), InStr(zr(i), "."), 3)
    zr(i) = a1 & b1
    End If
   
    s1 = Int(Val(zr(i) + 0.5))
    s = "/" & s1 & s
    zr(i) = s1
    Next
    For i1 = 1 To Val(j - sb1 + 1)
    zr(sb1 + i1 - 2) = 0
    Next
   
   
   
    For i1 = 0 To n - 1
    If zr(i1) < 0 Then
    zr(i1) = 0
    Else
    zr(i1) = zr(i1)
    End If
   
    s5 = "/" & Int(zr(i1)) & s5
    If i1 = 0 Then
    s6 = Int(zr(i1)) \ 10
    s8 = Int(zr(i1)) Mod 10
    ElseIf Val(zr(i1)) >= 0 Then
    s7 = Int(zr(i1)) + Val(s6)
    s10 = Val(s7) Mod 10
    s11 = s10 & s11
    s6 = Val(s7) \ 10
    Else
    s6 = Val(s6)
    End If
   
    Next
    s9 = s6 & s11 & s8
   
nifft = s9

End Function

Private Function dxcx0(sa As String, sb As String) As String

Dim x_() As Double, a As String
  a = Trim(sa)
  ReDim x_(1 To sb)
  For i1 = 1 To sb
  x_(i1) = Mid(a, sb - 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 = 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
  s = s & x_(j + 1)
  Next
  dxcx0 = x_(1) & x_(1 + sb / 2) & s
  

End Function

Private Function dxcx1(sa As String) As String

Dim x_() As Double, a As String
  a = Trim(sa)
   

s2 = Split(sa, "/")
s3 = Split(sb, "/")
    j = UBound(s2)
    sb = j
   
     ReDim x_(1 To sb)
   For k = 1 To j
       n1 = n1 + 1
        ReDim Preserve x_(1 To n1)
      
       x_(n1) = s2(n1)
     Next
  Dim n As Integer, i As Long, mn As Long, lh As Long, t As Double
  '位序倒置
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
  s = s & "/" & x_(j + 1)
  Next
  dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
  
  End Function

又改进了一下，小数点后面的有效数字全保留，这样居然都对了，就是这样太占空间，再改一下吧，代码如下：

Private Sub Command1_Click()
 Dim xr() As Double, a As String
 a = Trim(Text1)
 b = Trim(Text3)
 sb1 = Len(a) + Len(b)
 sb2 = Log(sb1) / Log(2)
 If InStr(sb2, ".") = 0 Then
 sb2 = sb2
 Else
 sb2 = Int(sb2) + 1
 End If
 sb = 2 ^ sb2
 Print sb
 If Len(a) = Len(b) And 2 ^ (Int(Log(Len(a)) / Log(2))) = Len(a) Then
   a = String(Val(sb) - Len(a), "0") & a
 b = String(Val(sb) - Len(b), "0") & b
 a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
 Else

 a = String(Val(sb) - Len(a), "0") & a
 b = String(Val(sb) - Len(b), "0") & b
 a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
 End If
 ReDim xr(0 To Len(a) - 1): ReDim yr(0 To Len(b) - 1): ReDim zr(0 To Len(b) - 1)
 For i1 = 0 To Len(a) - 1
 xr(i1) = Mid(a, i1 + 1, 1)
 yr(i1) = Mid(b, i1 + 1, 1)

    Next
 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 xi(): Dim yi(): Dim zi()
 n = Len(a) '求数组大小，其值必须是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
   
     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)
     

     s = s & "/" & zr(i)
     s1 = s1 & "/" & zi(i)
     Next
    s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
    s3 = nifft(Trim(s), Trim(s1), Trim(sb1))
     Text2 = s2
 End Sub

 Private Sub Command2_Click()
 Text1 = ""
 Text2 = ""
 Text3 = ""
 Form1.Cls
 End Sub

 Private Function nifft(sa As String, sb As String, sb1 As String) As String
 Dim l As Long, le As Long, le1 As Long, j 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 xi(): Dim yi(): Dim zi()
 Dim xr(), yr(), zr()
 s2 = Split(sa, "/")
 s3 = Split(sb, "/")
     j = UBound(s2)
     n = j
    For k = 1 To j
        n1 = n1 + 1
         ReDim Preserve xr(0 To n1 - 1)
         ReDim Preserve yr(0 To n1 - 1)
        xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
      Next
   

 ReDim zr(0 To j - 1)

 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 = -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
   
     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) - yi(i)) / n
     
   
     s1 = Int(Val(zr(i) + 0.5))
     s = "/" & s1 & s
     zr(i) = s1
     Next
     For i1 = 1 To Val(j - sb1 + 1)
     zr(sb1 + i1 - 2) = 0
     Next
     
   
   
     For i1 = 0 To n - 1
     If zr(i1) < 0 Then
     zr(i1) = 0
     Else
     zr(i1) = zr(i1)
     End If
     
     s5 = "/" & Int(zr(i1)) & s5
     If i1 = 0 Then
     s6 = Int(zr(i1)) \ 10
     s8 = Int(zr(i1)) Mod 10
     ElseIf Val(zr(i1)) >= 0 Then
     s7 = Int(zr(i1)) + Val(s6)
     s10 = Val(s7) Mod 10
     s11 = s10 & s11
     s6 = Val(s7) \ 10
     Else
     s6 = Val(s6)
     End If
   
     Next
     s9 = s6 & s11 & s8
   
 nifft = s9

 End Function

 Private Function dxcx0(sa As String, sb As String) As String

 Dim x_() As Double, a As String
   a = Trim(sa)
   ReDim x_(1 To sb)
   For i1 = 1 To sb
   x_(i1) = Mid(a, sb - 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 = 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
   s = s & x_(j + 1)
   Next
   dxcx0 = x_(1) & x_(1 + sb / 2) & s
   

 End Function

 Private Function dxcx1(sa As String) As String

 Dim x_() As Double, a As String
   a = Trim(sa)
   

 s2 = Split(sa, "/")
 s3 = Split(sb, "/")
     j = UBound(s2)
     sb = j
   
      ReDim x_(1 To sb)
    For k = 1 To j
        n1 = n1 + 1
         ReDim Preserve x_(1 To n1)
      
        x_(n1) = s2(n1)
      Next
   Dim n As Integer, i As Long, mn As Long, lh As Long, t As Double
   '位序倒置
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
   s = s & "/" & x_(j + 1)
   Next
   dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
   End Function

111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*111111111=12345678999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999987654321有116位（这个是对的），有时候中间会出现两个错误数字，咋回事呢？不可靠了？需要再做研究调整！

额，我用差程序了，用的是没有调整好的程序，改回来后结果全是对的，就是速度慢了！！需要研究优化：
11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=1122222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有331位,用时2.648438秒.

不知道如何优化，希望老师指点！

优化一下，可以提高速度的，好像是有提升空间：
11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=1122222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有331位，用时1.554688秒.

速度基本无法再提高了，改一下算法，改为8位一组试试，如何呢？如下是优化后的代码（还没有改成8位一组的）：
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

Private Sub Command1_Click()
  Dim xr() As Double, a As String
  a = Trim(Text1)
  b = Trim(Text3)
  ts = Timer
  sb1 = Len(a) + Len(b)
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  Print sb
  If Len(a) = Len(b) And 2 ^ (Int(Log(Len(a)) / Log(2))) = Len(a) Then
    a = String(Val(sb) - Len(a), "0") & a
  b = String(Val(sb) - Len(b), "0") & b
  a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
  Else

  a = String(Val(sb) - Len(a), "0") & a
  b = String(Val(sb) - Len(b), "0") & b
  a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
  End If
  ReDim xr(0 To Len(a) - 1): ReDim yr(0 To Len(b) - 1): ReDim zr(0 To Len(b) - 1)
  For i1 = 0 To Len(a) - 1
  xr(i1) = Mid(a, i1 + 1, 1)
  yr(i1) = Mid(b, i1 + 1, 1)

     Next
  
  Dim xi(): Dim yi(): Dim zi()
  n = Len(a) '求数组大小，其值必须是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
     
      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)
      

      s = s & "/" & zr(i)
      s1 = s1 & "/" & zi(i)
      Next
     s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     
      Text2 = s2 & "有" & Len(s2) & "位，用时" & Timer - ts & "秒"
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""
  Form1.Cls
  End Sub

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 nifft(sa As String, sb As String, sb1 As String) As String
  
  Dim xi(): Dim yi(): Dim zi()
  Dim xr(), yr(), zr()
  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      j = UBound(s2)
      n = j
     For k = 1 To j
         n1 = n1 + 1
          ReDim Preserve xr(0 To n1 - 1)
          ReDim Preserve yr(0 To n1 - 1)
         xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
       Next
     

  ReDim zr(0 To j - 1)

  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 = -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
     
      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) - yi(i)) / n
      
     
      s1 = Int(Val(zr(i) + 0.5))
      s = "/" & s1 & s
      zr(i) = s1
      Next
      For i1 = 1 To Val(j - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = 0
      Else
      zr(i1) = zr(i1)
      End If
      
      
      If i1 = 0 Then
      s6 = Int(zr(i1)) \ 10
      s8 = Int(zr(i1)) Mod 10
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = Int(zr(i1)) + Val(s6)
      s10 = Val(s7) Mod 10
      s11 = s10 & s11
      s6 = Val(s7) \ 10
      Else
      s6 = Val(s6)
      End If
     
      Next
      s9 = s6 & s11 & s8
     
  nifft = qdqd0(Trim(s9))

  End Function

  Private Function dxcx0(sa As String, sb As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
    ReDim x_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, sb - 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 = 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
    s = s & x_(j + 1)
    Next
    dxcx0 = x_(1) & x_(1 + sb / 2) & s
   

  End Function

  Private Function dxcx1(sa As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
     

  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      j = UBound(s2)
      sb = j
     
       ReDim x_(1 To sb)
     For k = 1 To j
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = s2(n1)
       Next
    Dim n As Integer, i As Long, mn As Long, lh As Long, t As Double
    '位序倒置
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
    s = s & "/" & x_(j + 1)
    Next
    dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
    End Function

[此贴子已经被作者于2021-3-19 20:42编辑过]

好像能运行了，计算小的数值末尾多了1，程序结果：12345678*23456789=289589963907943有15位，用时0秒，实际为：289589963907942.
咋回事呢？速度快了反而不可靠了？代码如下：（改天再研究吧）

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

Private Sub Command1_Click()
  Dim xr() As String, a As String
  a = Trim(Text1)
  b = Trim(Text3)
  ts = Timer
  x = Len(a) \ 8: Y = Len(b) \ 8
  If Val(8 * x) = Len(a) Then
  a = a
  ElseIf Val(8 * Y) = Len(b) Then
  b = b
  Else
  a = InStr(Val(x * 8 + 8 - Len(a)), "0") & a
  b = InStr(Val(Y * 8 + 8 - Len(b)), "0") & b
  x = x + 1: Y = Y + 1
  End If
  
  
  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
  Print sb
  

  a = String(Val(sb) * 8 - Len(a), "0") & a
  b = String(Val(sb) * 8 - Len(b), "0") & b
  a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
  Print a
  ReDim xr(0 To (Len(a) - 8) \ 8): ReDim yr(0 To (Len(b) - 8) \ 8): ReDim zr(0 To (Len(b) - 8) \ 8)
  If Len(a) = 8 Then
  xr(0) = a: yr(0) = b
  Else
  For i1 = 0 To (Len(a) - 8) \ 8
  xr(i1) = Mid(a, (i1 + 1) * 8 - 7, 8)
  yr(i1) = Mid(b, (i1 + 1) * 8 - 7, 8)

     Next
     End If
  
  Dim xi(): Dim yi(): Dim zi()
  n = Len(a) \ 8 '求数组大小，其值必须是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
     
      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)
      

      s = s & "/" & zr(i)
      s1 = s1 & "/" & zi(i)
      Next
     s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     
      Text2 = s2 & "有" & Len(s2) & "位，用时" & Timer - ts & "秒"
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""
  Form1.Cls
  End Sub

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 nifft(sa As String, sb As String, sb1 As String) As String
  
  Dim xi(): Dim yi(): Dim zi()
  Dim xr(), yr()
  Dim zr() As String
  
  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      j = UBound(s2)
      n = j
     For k = 1 To j
         n1 = n1 + 1
          ReDim Preserve xr(0 To n1 - 1)
          ReDim Preserve yr(0 To n1 - 1)
         xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
       Next
     

  ReDim zr(0 To j - 1)

  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 = -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
     
      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) - yi(i)) / n
      
     
      s1 = Int(Val(zr(i) + 0.5))
      s = "/" & s1 & s
      zr(i) = s1
      Next
      For i1 = 1 To Val(j - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = 0
      Else
      zr(i1) = Format(zr(i1), "#")
      End If
      
      
      If i1 = 0 Then
      If Len(zr(i1)) < 8 Then
      zr(i1) = InStr(8 - Len(zr(i1)), "0") & zr(i1)
      Else
      zr(i1) = zr(i1)
      End If
      s6 = Val(Left(zr(i1), Len(zr(i1)) - 8))
      If Len(s6) < 8 Then
      s6 = InStr(8 - Len(s6), "0") & s6
      Else
      s6 = s6
      End If
      s8 = Right(zr(i1), 8)
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = Val(zr(i1)) + Val(s6)
      s10 = Right(s7, 8)
      s11 = s10 & s11
      If Len(s7) < 8 Then
      s7 = InStr(8 - Len(s7), "0") & s7
      ElseIf Len(s7) = 8 Then
      s6 = "00000000"
      Else
      s7 = s7
      s6 = Val(Left(s7, Len(s7) - 8))
      End If
      Else
      s6 = s6
      End If
     
      Next
      s9 = s6 & s11 & s8
     
  nifft = qdqd0(Trim(s9))

  End Function

  Private Function dxcx0(sa As String, sb As String) As String

  Dim x_() As String, a As String
    a = Trim(sa)
    ReDim x_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, (sb - i1 + 1) * 8 - 7, 8)
    If Len(x_(i1)) < 8 Then
    x_(i1) = InStr(8 - Len(x_(i1)), "0") & x_(i1)
    Else
    x_(i1) = x_(i1)
    End If
   
      Next
    Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, 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
    s = s & x_(j + 1)
    Next
    dxcx0 = x_(1) & x_(1 + sb / 2) & s
   
   

  End Function

  Private Function dxcx1(sa As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
     

  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      j = UBound(s2)
      sb = j
     
       ReDim x_(1 To sb)
     For k = 1 To j
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = s2(n1)
       Next
    Dim n As Integer, i As Long, mn As Long, lh As Long, t As Double
    '位序倒置
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
    s = s & "/" & x_(j + 1)
    Next
    dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
    End Function

[此贴子已经被作者于2021-3-19 23:29编辑过]

11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=11111111111111111111111111111111111111111111111122222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有377位，用时0.328125秒。

速度够快，末尾好像也对，高位多了那么多0，咋回事？377-331=46，多了46个1？咋回事呢？

[此贴子已经被作者于2021-3-20 08:13编辑过]

1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*9=9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999有100位，用时7.092285E-02秒.
晚安吧！还有客人呢？祝愿各位老师做个好梦，您安好！