使用 Excel 的 VBA 进行快速傅里叶变换
Fast Fourier Transform Using Excel's VBA
我正在尝试在 MS Excel VBA 中实现快速傅里叶变换 (Radix-2)。我正在使用的代码从工作表中的一个范围中提取数据，进行计算，然后将结果转储到相邻的列中。我遇到的问题是 1) 知道如何处理生成的 X[k] 数组，以及 2) 将这些结果与 Excel 内置 FFT 的结果相匹配（它们目前不匹配） .代码如下所示。在此先感谢您的帮助。
Sub Enforce_DecimationInTime()
On Error GoTo ERROR_HANDLING
Dim SubName As String
SubName = "Enforce_DecimationInTime()"
Dim WS As Worksheet
Dim n As Long, v As Long, LR As Long, x As Long
Set WS = Worksheets("FFT")
LR = WS.Range("A" & Rows.Count).End(xlUp).Row
n = LR - 1
Do Until 2 ^ x <= n And 2 ^ (x + 1) > n 'locates largest power of 2 from size of input array
x = x + 1
Loop
n = n - (n - 2 ^ x) 'calculates n using the largest power of 2
If n + 1 <> WS.Range("A" & Rows.Count).End(xlUp).Row Then
WS.Range("A" & 2 ^ x + 2 & ":A" & LR).Delete xlUp 'deletes extra input data
End If
v = WorksheetFunction.Log(n, 2) 'calculates number of decimations necessary
Application.ScreenUpdating = False
For x = 1 To v
Call Called_Core.DecimationInTime(WS, n, 2 ^ x, x) 'calls decimation in time subroutine
Next x
Application.ScreenUpdating = True
Exit Sub
ERROR_HANDLING:
MsgBox "Error encountered in " & SubName & ": exiting subroutine." _
& vbNewLine _
& vbNewLine & "Error description: " & Err.Description _
& vbNewLine & "Error number: " & Err.Number, vbCritical, Title:="Error!"
End
End Sub
上面的子程序通过For/Next循环调用下面的子程序到"v"的计数。
Sub DecimationInTime(WS As Worksheet, n As Long, Factor As Integer, x As Long)
On Error GoTo ERROR_HANDLING
Dim SubName As String
SubName = "DecimationInTime()"
Dim f_1() As Single, f_2() As Single
Dim i As Long, m As Long, k As Long
Dim TFactor_N1 As String, TFactor_N2 As String, X_k() As String
Dim G_1() As Variant, G_2() As Variant
ReDim f_1(0 To n / Factor - 1) As Single
ReDim f_2(0 To n / Factor - 1) As Single
ReDim G_1(0 To n / 1 - 1) As Variant
ReDim G_2(0 To n / 1 - 1) As Variant
ReDim X_k(0 To n - 1) As String
TFactor_N1 = WorksheetFunction.Complex(0, -2 * WorksheetFunction.Pi / (n / 1)) 'twiddle factor for N
TFactor_N2 = WorksheetFunction.Complex(0, -2 * WorksheetFunction.Pi / (n / 2)) 'twiddle factor for N/2
For i = 0 To n / Factor - 1
f_1(i) = WS.Range("A" & 2 * i + 2).Value 'assign input data
f_2(i) = WS.Range("A" & 2 * i + 3).Value 'assign input data
Next i
WS.Cells(1, 1 + x).Value = "X[" & x & "]" 'labels X[k] column with k number
For k = 0 To n / 2 - 1
For m = 0 To n / Factor - 1
G_1(m) = WorksheetFunction.ImProduct(WorksheetFunction.ImPower(TFactor_N2, k * m), WorksheetFunction.Complex(f_1(m), 0)) 'defines G_1[m]
G_2(m) = WorksheetFunction.ImProduct(WorksheetFunction.ImPower(TFactor_N2, k * m), WorksheetFunction.Complex(f_2(m), 0)) 'defines G_2[m]
Next m
X_k(k) = WorksheetFunction.ImSum(WorksheetFunction.ImSum(G_1), WorksheetFunction.ImProduct(WorksheetFunction.ImSum(G_2), WorksheetFunction.ImPower(TFactor_N1, k))) 'defines X[k] for k
If k <= n / 2 Then X_k(k + n / 2) = WorksheetFunction.ImSum(WorksheetFunction.ImSum(G_1), WorksheetFunction.ImProduct(WorksheetFunction.ImSum(G_2), WorksheetFunction.ImPower(TFactor_N1, k), WorksheetFunction.Complex(-1, 0))) 'defines X[k] for k + n/2
WS.Cells(k + 2, 1 + x).Value = X_k(k)
WS.Cells(k + 2 + n / 2, 1 + x).Value = X_k(k + n / 2)
Next k
Exit Sub
ERROR_HANDLING:
MsgBox "Error encountered in " & SubName & ": exiting subroutine." _
& vbNewLine _
& vbNewLine & "Error description: " & Err.Description _
& vbNewLine & "Error number: " & Err.Number, vbCritical, Title:="Error!"
End
End Sub
我回顾了整个过程并确定我的问题是我为旋转因子 TFactor_N1 和 TFactor_N2 分配了错误的值。解决此问题并调整显示的值后，我能够获得与 Excel 内置 FFT 相同的结果。固定代码如下所示。
Sub Enforce_DecimationInTime()
On Error GoTo ERROR_HANDLING
Dim SubName As String
SubName = "Enforce_DecimationInTime()"
Dim WS As Worksheet
Dim n As Long, v As Long, LR As Long, x As Long
Dim TFactor_N1 As String, TFactor_N2 As String
Set WS = Worksheets("FFT")
LR = WS.Range("A" & Rows.Count).End(xlUp).Row
n = LR - 1
Do Until 2 ^ x <= n And 2 ^ (x + 1) > n 'locates largest power of 2 from size of input array
x = x + 1
Loop
n = n - (n - 2 ^ x) 'calculates n using the largest power of 2
If n + 1 <> WS.Range("A" & Rows.Count).End(xlUp).Row Then
WS.Range("A" & 2 ^ x + 2 & ":A" & LR).Delete xlUp 'deletes extra input data
End If
v = WorksheetFunction.Log(n, 2) 'calculates number of decimations necessary
TFactor_N1 = WorksheetFunction.ImExp(WorksheetFunction.Complex(0, -2 * WorksheetFunction.Pi / (n / 1))) 'twiddle factor for N
TFactor_N2 = WorksheetFunction.ImExp(WorksheetFunction.Complex(0, -2 * WorksheetFunction.Pi / (n / 2))) 'twiddle factor for N/2
Application.ScreenUpdating = False
For x = 1 To v
Call Called_Core.DecimationInTime(WS, n, 2 ^ x, x, TFactor_N1, TFactor_N2) 'calls decimation in time subroutine
Next x
Application.ScreenUpdating = True
Exit Sub
ERROR_HANDLING:
MsgBox "Error encountered in " & SubName & ": exiting subroutine." _
& vbNewLine _
& vbNewLine & "Error description: " & Err.Description _
& vbNewLine & "Error number: " & Err.Number, vbCritical, Title:="Error!"
End
End Sub
Sub DecimationInTime(WS As Worksheet, n As Long, Factor As Integer, x As Long, TFactor_N1 As String, TFactor_N2 As String)
On Error GoTo ERROR_HANDLING
Dim SubName As String
SubName = "DecimationInTime()"
Dim f_1() As String, f_2() As String
Dim i As Long, m As Long, k As Long
Dim X_k() As String
Dim G_1() As Variant, G_2() As Variant
ReDim f_1(0 To n / Factor - 1) As String
ReDim f_2(0 To n / Factor - 1) As String
ReDim G_1(0 To n / 1 - 1) As Variant
ReDim G_2(0 To n / 1 - 1) As Variant
ReDim X_k(0 To n - 1) As String
For i = 0 To n / Factor - 1
f_1(i) = WS.Cells(2 * i + 2, 1).Value 'assign input data
f_2(i) = WS.Cells(2 * i + 3, 1).Value 'assign input data
Next i
For k = 0 To n / 2 - 1
For m = 0 To n / Factor - 1 'defines G_1[m] and G_2[m]
G_1(m) = WorksheetFunction.ImProduct(WorksheetFunction.ImPower(TFactor_N2, k * m), f_1(m))
G_2(m) = WorksheetFunction.ImProduct(WorksheetFunction.ImPower(TFactor_N2, k * m), f_2(m))
Next m 'defines X[k] for k and k + n/2
X_k(k) = WorksheetFunction.ImSum(WorksheetFunction.ImSum(G_1), WorksheetFunction.ImProduct(WorksheetFunction.ImSum(G_2), WorksheetFunction.ImPower(TFactor_N1, k)))
If k <= n / 2 Then X_k(k + n / 2) = WorksheetFunction.ImSub(WorksheetFunction.ImSum(G_1), WorksheetFunction.ImProduct(WorksheetFunction.ImSum(G_2), WorksheetFunction.ImPower(TFactor_N1, k)))
If x = 1 Then
WS.Cells(k + 2, 1 + x).Value = X_k(k)
WS.Cells(k + 2 + n / 2, 1 + x).Value = X_k(k + n / 2)
End If
Next k
Exit Sub
ERROR_HANDLING:
MsgBox "Error encountered in " & SubName & ": exiting subroutine." _
& vbNewLine _
& vbNewLine & "Error description: " & Err.Description _
& vbNewLine & "Error number: " & Err.Number, vbCritical, Title:="Error!"
End
End Sub
函数调用不好
调用 Called_Core.DecimationInTime(WS, n, 2 ^ x, x, TFactor_N1, TFactor_N2)
应该是：
调用 DecimationInTime(WS, n, 2 ^ x, x, TFactor_N1, TFactor_N2)
我正在尝试在 MS Excel VBA 中实现快速傅里叶变换 (Radix-2)。我正在使用的代码从工作表中的一个范围中提取数据，进行计算，然后将结果转储到相邻的列中。我遇到的问题是 1) 知道如何处理生成的 X[k] 数组，以及 2) 将这些结果与 Excel 内置 FFT 的结果相匹配（它们目前不匹配） .代码如下所示。在此先感谢您的帮助。
Sub Enforce_DecimationInTime()
On Error GoTo ERROR_HANDLING
Dim SubName As String
SubName = "Enforce_DecimationInTime()"
Dim WS As Worksheet
Dim n As Long, v As Long, LR As Long, x As Long
Set WS = Worksheets("FFT")
LR = WS.Range("A" & Rows.Count).End(xlUp).Row
n = LR - 1
Do Until 2 ^ x <= n And 2 ^ (x + 1) > n 'locates largest power of 2 from size of input array
x = x + 1
Loop
n = n - (n - 2 ^ x) 'calculates n using the largest power of 2
If n + 1 <> WS.Range("A" & Rows.Count).End(xlUp).Row Then
WS.Range("A" & 2 ^ x + 2 & ":A" & LR).Delete xlUp 'deletes extra input data
End If
v = WorksheetFunction.Log(n, 2) 'calculates number of decimations necessary
Application.ScreenUpdating = False
For x = 1 To v
Call Called_Core.DecimationInTime(WS, n, 2 ^ x, x) 'calls decimation in time subroutine
Next x
Application.ScreenUpdating = True
Exit Sub
ERROR_HANDLING:
MsgBox "Error encountered in " & SubName & ": exiting subroutine." _
& vbNewLine _
& vbNewLine & "Error description: " & Err.Description _
& vbNewLine & "Error number: " & Err.Number, vbCritical, Title:="Error!"
End
End Sub
上面的子程序通过For/Next循环调用下面的子程序到"v"的计数。
Sub DecimationInTime(WS As Worksheet, n As Long, Factor As Integer, x As Long)
On Error GoTo ERROR_HANDLING
Dim SubName As String
SubName = "DecimationInTime()"
Dim f_1() As Single, f_2() As Single
Dim i As Long, m As Long, k As Long
Dim TFactor_N1 As String, TFactor_N2 As String, X_k() As String
Dim G_1() As Variant, G_2() As Variant
ReDim f_1(0 To n / Factor - 1) As Single
ReDim f_2(0 To n / Factor - 1) As Single
ReDim G_1(0 To n / 1 - 1) As Variant
ReDim G_2(0 To n / 1 - 1) As Variant
ReDim X_k(0 To n - 1) As String
TFactor_N1 = WorksheetFunction.Complex(0, -2 * WorksheetFunction.Pi / (n / 1)) 'twiddle factor for N
TFactor_N2 = WorksheetFunction.Complex(0, -2 * WorksheetFunction.Pi / (n / 2)) 'twiddle factor for N/2
For i = 0 To n / Factor - 1
f_1(i) = WS.Range("A" & 2 * i + 2).Value 'assign input data
f_2(i) = WS.Range("A" & 2 * i + 3).Value 'assign input data
Next i
WS.Cells(1, 1 + x).Value = "X[" & x & "]" 'labels X[k] column with k number
For k = 0 To n / 2 - 1
For m = 0 To n / Factor - 1
G_1(m) = WorksheetFunction.ImProduct(WorksheetFunction.ImPower(TFactor_N2, k * m), WorksheetFunction.Complex(f_1(m), 0)) 'defines G_1[m]
G_2(m) = WorksheetFunction.ImProduct(WorksheetFunction.ImPower(TFactor_N2, k * m), WorksheetFunction.Complex(f_2(m), 0)) 'defines G_2[m]
Next m
X_k(k) = WorksheetFunction.ImSum(WorksheetFunction.ImSum(G_1), WorksheetFunction.ImProduct(WorksheetFunction.ImSum(G_2), WorksheetFunction.ImPower(TFactor_N1, k))) 'defines X[k] for k
If k <= n / 2 Then X_k(k + n / 2) = WorksheetFunction.ImSum(WorksheetFunction.ImSum(G_1), WorksheetFunction.ImProduct(WorksheetFunction.ImSum(G_2), WorksheetFunction.ImPower(TFactor_N1, k), WorksheetFunction.Complex(-1, 0))) 'defines X[k] for k + n/2
WS.Cells(k + 2, 1 + x).Value = X_k(k)
WS.Cells(k + 2 + n / 2, 1 + x).Value = X_k(k + n / 2)
Next k
Exit Sub
ERROR_HANDLING:
MsgBox "Error encountered in " & SubName & ": exiting subroutine." _
& vbNewLine _
& vbNewLine & "Error description: " & Err.Description _
& vbNewLine & "Error number: " & Err.Number, vbCritical, Title:="Error!"
End
End Sub
我回顾了整个过程并确定我的问题是我为旋转因子 TFactor_N1 和 TFactor_N2 分配了错误的值。解决此问题并调整显示的值后，我能够获得与 Excel 内置 FFT 相同的结果。固定代码如下所示。
Sub Enforce_DecimationInTime()
On Error GoTo ERROR_HANDLING
Dim SubName As String
SubName = "Enforce_DecimationInTime()"
Dim WS As Worksheet
Dim n As Long, v As Long, LR As Long, x As Long
Dim TFactor_N1 As String, TFactor_N2 As String
Set WS = Worksheets("FFT")
LR = WS.Range("A" & Rows.Count).End(xlUp).Row
n = LR - 1
Do Until 2 ^ x <= n And 2 ^ (x + 1) > n 'locates largest power of 2 from size of input array
x = x + 1
Loop
n = n - (n - 2 ^ x) 'calculates n using the largest power of 2
If n + 1 <> WS.Range("A" & Rows.Count).End(xlUp).Row Then
WS.Range("A" & 2 ^ x + 2 & ":A" & LR).Delete xlUp 'deletes extra input data
End If
v = WorksheetFunction.Log(n, 2) 'calculates number of decimations necessary
TFactor_N1 = WorksheetFunction.ImExp(WorksheetFunction.Complex(0, -2 * WorksheetFunction.Pi / (n / 1))) 'twiddle factor for N
TFactor_N2 = WorksheetFunction.ImExp(WorksheetFunction.Complex(0, -2 * WorksheetFunction.Pi / (n / 2))) 'twiddle factor for N/2
Application.ScreenUpdating = False
For x = 1 To v
Call Called_Core.DecimationInTime(WS, n, 2 ^ x, x, TFactor_N1, TFactor_N2) 'calls decimation in time subroutine
Next x
Application.ScreenUpdating = True
Exit Sub
ERROR_HANDLING:
MsgBox "Error encountered in " & SubName & ": exiting subroutine." _
& vbNewLine _
& vbNewLine & "Error description: " & Err.Description _
& vbNewLine & "Error number: " & Err.Number, vbCritical, Title:="Error!"
End
End Sub
Sub DecimationInTime(WS As Worksheet, n As Long, Factor As Integer, x As Long, TFactor_N1 As String, TFactor_N2 As String)
On Error GoTo ERROR_HANDLING
Dim SubName As String
SubName = "DecimationInTime()"
Dim f_1() As String, f_2() As String
Dim i As Long, m As Long, k As Long
Dim X_k() As String
Dim G_1() As Variant, G_2() As Variant
ReDim f_1(0 To n / Factor - 1) As String
ReDim f_2(0 To n / Factor - 1) As String
ReDim G_1(0 To n / 1 - 1) As Variant
ReDim G_2(0 To n / 1 - 1) As Variant
ReDim X_k(0 To n - 1) As String
For i = 0 To n / Factor - 1
f_1(i) = WS.Cells(2 * i + 2, 1).Value 'assign input data
f_2(i) = WS.Cells(2 * i + 3, 1).Value 'assign input data
Next i
For k = 0 To n / 2 - 1
For m = 0 To n / Factor - 1 'defines G_1[m] and G_2[m]
G_1(m) = WorksheetFunction.ImProduct(WorksheetFunction.ImPower(TFactor_N2, k * m), f_1(m))
G_2(m) = WorksheetFunction.ImProduct(WorksheetFunction.ImPower(TFactor_N2, k * m), f_2(m))
Next m 'defines X[k] for k and k + n/2
X_k(k) = WorksheetFunction.ImSum(WorksheetFunction.ImSum(G_1), WorksheetFunction.ImProduct(WorksheetFunction.ImSum(G_2), WorksheetFunction.ImPower(TFactor_N1, k)))
If k <= n / 2 Then X_k(k + n / 2) = WorksheetFunction.ImSub(WorksheetFunction.ImSum(G_1), WorksheetFunction.ImProduct(WorksheetFunction.ImSum(G_2), WorksheetFunction.ImPower(TFactor_N1, k)))
If x = 1 Then
WS.Cells(k + 2, 1 + x).Value = X_k(k)
WS.Cells(k + 2 + n / 2, 1 + x).Value = X_k(k + n / 2)
End If
Next k
Exit Sub
ERROR_HANDLING:
MsgBox "Error encountered in " & SubName & ": exiting subroutine." _
& vbNewLine _
& vbNewLine & "Error description: " & Err.Description _
& vbNewLine & "Error number: " & Err.Number, vbCritical, Title:="Error!"
End
End Sub
函数调用不好 调用 Called_Core.DecimationInTime(WS, n, 2 ^ x, x, TFactor_N1, TFactor_N2)
应该是： 调用 DecimationInTime(WS, n, 2 ^ x, x, TFactor_N1, TFactor_N2)