Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = zr(i) & "/" & s
   s1 = zi(i) & "/" & s1
   Next
   Text2 = s1
End Sub

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

输入：Text1 =80607000，Text2=20403000,结果：
实部： 24.76/-6.76/-5.62/21/8.07/-9.10/48.12/189/
虚部：  7.92/-6.46/4.15/0/-4.83/0.84/-33.84/0/
与正确值比较：-13.6+123.4i, -25-8i, -2.4-5.8i, 21, -2.4+5.8i, -25+8i, -13.6-123.4i, 189也是不对。

[此贴子已经被作者于2021-1-4 11:47编辑过]

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
   Dim c(), d()
s2 = Split(s, "/")
s3 = Split(s1, "/")
   j = UBound(s2)
  For k = 1 To j
      n1 = n1 + 1
       ReDim Preserve c(0 To n1 - 1)
       ReDim Preserve d(0 To n1 - 1)
      c(n1 - 1) = s2(n1): d(n1 - 1) = s3(n1)
    Next
   Text2 = s
End Sub

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


输入：Text1 =80607000，Text2=20403000,结果：
 /24.76/-6.76/-5.62/21/8.07/-9.10/48.12/189
  /7.92/-6.46/4.15/0/-4.83/0.84/-33.84/0
与正确值比较：-13.6+123.4i, -25-8i, -2.4-5.8i, 21, -2.4+5.8i, -25+8i, -13.6-123.4i, 189也是不对。

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
  s2 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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
  t = pi / le1
  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

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

For i = 0 To n - 1 '仅输出模

   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
   If InStr(yr(i), ".") = 0 Then
   yr(i) = yr(i)
   Else
   a2 = Left(yr(i), InStr(yr(i), ".") - 1)
   b2 = Mid(yr(i), InStr(yr(i), "."), 3)
   yr(i) = a2 & b2
   End If
   s = "/" & Val(zr(i) + yr(i)) & s
   Next
   
   
nifft = s

End Function



输入：Text1 =80607000，Text2=20403000,结果：
/13.13/-7.06/18.38/43.44/15.62/1.68/10.37/-32.22
与正确值比较：0, 0, 0, 0, 24, 46, 65, 38, 16也是不对。

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
  s2 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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)
   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
   Next
   
   
nifft = s

End Function


输入：Text1 =80607000，Text2=20403000,结果：
/48/30/38/-159/43/-31/54/237
与正确值比较：0, 0, 0, 24, 46, 65, 38, 16也是不对。

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
  s2 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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)
   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
   Next
   
   
nifft = s

End Function


输入：Text1 =80607000，Text2=20403000,结果：
/50/-65/44/-159/41/65/48/237
与正确值比较：0, 0, 0, 24, 46, 65, 38, 16也是不对。

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

For i = 1 To n - 2


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

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



输入Text1=00000678,输出Text2=80607000.

[此贴子已经被作者于2021-1-7 16:30编辑过]

Private Sub Command1_Click()

Text2 = fftdx(Trim(Text1))
End Sub

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

Private Function fftdx(sa As String) As String

Dim x_() As Double, a As String
a = sa
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = Mid(a, i1 + 1, 1)
  Next
Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = Len(a) '求数组大小，其值必须是2的幂
lh = n / 2
j = n / 2

For i = 1 To n - 2


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




输入Text1=00000678,输出Text2=80607000.

Private Sub Command1_Click()

Text2 = fftdx(Trim(Text1))
End Sub

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

Private Function fftdx(sa As String) As String

Dim x_() As Double, a As String
a = sa
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = Mid(a, i1 + 1, 1)
  Next
Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = Len(a) '求数组大小，其值必须是2的幂
lh = n / 2
j = n / 2

For i = 1 To n - 2


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

Private Function fftdx1(sa As String) As String

Dim x_() As Double, a As String
a = sa
s2 = Split(sa, "/")
   j = UBound(s2)
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = s2(i1 + 1)
  Next
Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = Len(a) '求数组大小，其值必须是2的幂
lh = n / 2
j = n / 2

For i = 1 To n - 2


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


输入Text1=00000432,输出Text2=20403000.

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
  s2 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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()
sa = fftdx1(Trim(sa)): sb = fftdx1(Trim(sb))
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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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)
   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
   Next
   
   
nifft = s

End Function


Private Function fftdx(sa As String) As String

Dim x_() As Double, a As String
a = sa
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = Mid(a, i1 + 1, 1)
  Next
Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = Len(a) '求数组大小，其值必须是2的幂
lh = n / 2
j = n / 2

For i = 1 To n - 2


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

Private Function fftdx1(sa As String) As String

Dim x_() As Double, a As String
a = sa
s2 = Split(sa, "/")
   j = UBound(s2)
ReDim x_(0 To j - 1)
For i1 = 0 To j - 1
x_(i1) = s2(i1 + 1)
 Next
Dim n As Integer, i As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = j '求数组大小，其值必须是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
ts = "/" & x_(j) & ts
Next
fftdx1 = ts & "/" & x_(n / 2) & "/" & x_(0)
End Function



输入Text1=80607000,Text2=20403000. 输出Text3=/174/224/165/140/162/239/171/237.
与正确值比较：0, 0, 0, 24, 46, 65, 38, 16也是不对。

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
  s2 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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()
sa = fftdx1(Trim(sa)): sb = fftdx1(Trim(sb))
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
  t = pi / le1
  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

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
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)
   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
   Next
   
   
nifft = s

End Function


Private Function fftdx(sa As String) As String

Dim x_() As Double, a As String
a = sa
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = Mid(a, i1 + 1, 1)
  Next
Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = Len(a) '求数组大小，其值必须是2的幂
lh = n / 2
j = n / 2

For i = 1 To n - 2


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

Private Function fftdx1(sa As String) As String

Dim x_() As Double, a As String
a = sa
s2 = Split(sa, "/")
   j = UBound(s2)
ReDim x_(0 To j - 1)
For i1 = 0 To j - 1
x_(i1) = s2(i1 + 1)
 Next
Dim n As Integer, i As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = j '求数组大小，其值必须是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
ts = "/" & x_(j) & ts
Next
fftdx1 = ts & "/" & x_(n / 2) & "/" & x_(0)
End Function


输入Text1=80607000,Text2=20403000. 输出Text3=/171/235/157/140/165/228/179/237.
与正确值比较：0, 0, 0, 24, 46, 65, 38, 16也是不对。