ALTracer

Fourier via Excel VBA

Sep 24th, 2020 (edited)
1,022
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Function CFourier_fix_coef(w_B, addr_cell) As Double
  2.  
  3. 'Const Ts As Double = 1 / 1200
  4. Dim C(24) As Double
  5.  
  6.     ' Цикл для вычисления коэффициентов
  7.    For i = 1 To 24
  8.         C(i) = Sin((i - 1) * w_B / 1200)
  9.     Next i
  10.    
  11.     ' Цикл для вычисления орт.сост.
  12.    a = 0
  13.     If Range(addr_cell).Row < 24 + 3 Then
  14.         start_row = 28 - Range(addr_cell).Row
  15.     Else
  16.         start_row = 1
  17.     End If
  18.     For i = start_row To 24
  19.         x = Range(addr_cell).Offset(i - 24, 0)
  20.         'If IsNumeric(x) Then
  21.            a = a + x * C(i)
  22.         'End If
  23.    Next i
  24.    
  25.     a = a * 2 / 24
  26.    
  27.     CFourier_fix_coef = a
  28.  
  29. End Function
  30.  
  31. Function SFourier_fix_coef(w_B, addr_cell) As Double
  32. Dim S(24) As Double
  33.  
  34.     ' Цикл для вычисления коэффициентов
  35.    For i = 1 To 24
  36.         S(i) = Cos((i - 1) * w_B / 1200)
  37.     Next i
  38.    
  39.     ' Цикл для вычисления орт.сост.
  40.    a = 0
  41.     If Range(addr_cell).Row < 24 + 3 Then
  42.         start_row = 28 - Range(addr_cell).Row
  43.     Else
  44.         start_row = 1
  45.     End If
  46.     For i = start_row To 24
  47.         x = Range(addr_cell).Offset(i - 24, 0)
  48.         'If IsNumeric(x) Then
  49.            a = a + x * S(i)
  50.         'End If
  51.    Next i
  52.    
  53.     a = a * 2 / 24
  54.    
  55.     SFourier_fix_coef = a
  56.  
  57. End Function
RAW Paste Data