使用Excel的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 

Answer 1

我回到整个过程，并确定我的问题是，我已经给错误的因素，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