Листинг программы
Sub rgr()
Dim dw As Single 'ширина переходной полосы
Dim wf As Integer 'нижняя частота полосы пропускания
Dim L As Integer 'N=2*L+1 - кол-во отсчетов ИХ
Dim Kf As Single 'коэффициент передачи фильтра
Dim dt As Single 'шаг дискретизации по времени
Dim wp As Single 'нижняя граничная частота полосы пропускания расчетной АЧХ
Dim wv As Single 'верхняя частота - полупериод повторения АЧХ
Dim Gk As Single 'множитель Блэкмана
Dim ao As Single 'коэффициенты
Dim ak As Single 'ряда Фурье
Dim sum As Single 'сумма ak*cos(k*dt*w), исп-ся для вычисления отсчетов АЧХ
Dim wk As Single 'значение ИХ
Dim Aw As Single 'значение АЧХ
Dim Fw As Single 'значение ФЧХ
Dim w As Single 'частота
Dim G As String, a As String
Dim i As Integer, k As Integer
'Считывание исходных данных
wf = Range("B3")
dw = Range("B4")
L = Range("B5")
Kf = Range("B6")
dt = Range("B7")
wv = 3.14 / dt
wp = wf - dw / 2
'Вычисление множетелей Блэкмана
For k = 1 To (L + 1) Step 1
Gk = 0.42 + 0.5 * Cos(k * 3.14 / L) + 0.08 * Cos(2 * k * 3.14 / L)
Cells(k, 6) = Gk
Next
'Вычисление коэффициентов ряда Фурье
ao = 2 * Kf * (1 - wp / wv)
Cells(1, 7) = ao
For k = 1 To L Step 1
ak = -2 * Kf * Sin(k * dt * wp) / (k * 3.14)
Cells(k + 1, 7) = ak
Next
'Вычисление отсчетов ИХ
For k = 1 To (2 * L + 1) Step 1
If k < (L + 2) Then
G = "F" & (L + 2 - k)
a = "G" & (L + 2 - k)
Gk = Range(G)
ak = Range(a)
wk = 0.5 * Gk * ak
Cells(k, 8) = wk
Else
G = "F" & (k - L)
a = "G" & (k - L)
Gk = Range(G)
ak = Range(a)
wk = 0.5 * Gk * ak 'ИХ
Cells(k, 8) = wk
End If
Next
'Выисление отсчетов АЧХ и ФЧХ
i = 1
ao = Range("H201")
For w = 0 To wv Step wv / L
sum = 0
For k = 1 To L Step 1
a = "H" & (L + 1 - k)
ak = Range(a)
ak = 2 * ak
sum = sum + ak * Cos(k * dt * w)
Next
Cells(i, 9) = w
Aw = Abs(ao + sum) 'АЧХ
Cells(i, 10) = Aw
Fw = -L * dt * w 'ФЧХ
Cells(i, 11) = Fw
i = i + 1
Next
End Sub
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.