Присваивает имя "Sample" выделенному массиву
Sub AssignSample()
Dim MR As Object, R, i
    Set MR = Application.Selection
    MR.Name = "Sample"
    For i = 1 To MR.Count
      Cells(i + 1, 1) = i
    Next i
    R = MR.Count + 2
    Range(Cells(R, 1), Cells(1000, 2)).ClearContents
End Sub
'Перерисовка картинки
Sub Redraw()
    Range("F1:G401").Select
    Selection.Copy
    Range("H1").Select
    ActiveSheet.Paste
End Sub
Sub FindMaximums()
Dim i As Integer, k As Integer
Dim D(1 To DensityResolution) As Double
    Range("K2:L500").ClearContents
    For i = 1 To DensityResolution
        D(i) = Cells(i + 1, 7).Value
    Next i
    k = 1
    For i = 2 To DensityResolution - 1
        If D(i) > D(i - 1) And D(i) > D(i + 1) Then
            k = k + 1
            Cells(k, 12).Value = Format(D(i), "0.000")
            Cells(k, 11).Value = Cells(i + 1, 6).Value
        End If
    Next i
End Sub

-------------------

Option Explicit
Public Const DensityResolution = 400
Const VectorDim = 1000
Dim Vector(1 To VectorDim) As Double
Dim VectorLength As Integer
Dim Coefficients(0 To DensityResolution) As Double
Dim Dimension As Integer   'Размерность метода максимальной энтропии
'Вычисление коэффициентов метода максимальной энтропии
Private Sub MEMCF(ByRef sigma As Double, ByRef mju As Double)
Dim B0(1 To VectorDim), B1(1 To VectorDim) As Double
Dim Z(0 To DensityResolution) As Double
Dim x, y As Double
Dim i, j As Integer
    'Установка начальных значений
    mju = 0
    For i = 1 To VectorLength
         mju = mju + Vector(i) / VectorLength
    Next i
    For i = 1 To VectorLength
        Vector(i) = Vector(i) - mju
    Next i
    For i = 1 To Dimension
        Coefficients(i) = 0
        Z(i) = 0
    Next i
    Coefficients(0) = -1#
    Z(0) = -1#
    sigma = 0
    For i = 1 To VectorLength
        sigma = sigma + Vector(i) ^ 2 / VectorLength
    Next i
    For i = 1 To VectorLength - 1
        B0(i) = Vector(i)
        B1(i) = Vector(i + 1)
    Next i
    'Главный цикл
    For j = 1 To Dimension
        If j > 1 Then
           For i = 1 To VectorLength - j - 1
                B0(i) = B0(i) - Coefficients(j - 1) * B1(i)
                B1(i) = B1(i + 1) - Coefficients(j - 1) * B0(i + 1)
           Next i
        End If
        x = 0
        y = 0
        For i = 1 To VectorLength - j
            x = x + 2# / VectorLength * B0(i) * B1(i)
            y = y + 1# / VectorLength * (B0(i) ^ 2 + B1(i) ^ 2)
        Next i
        Coefficients(j) = x / y
        sigma = sigma * (1# - Coefficients(j) ^ 2)
        For i = 1 To j - 1
            Z(i) = Coefficients(i)
        Next i
        If j > 1 Then
            For i = 1 To j - 1
               Coefficients(i) = Z(i) - Coefficients(j) * Z(j - i)
            Next i
        End If
    Next j
    'Конец главного цикла
    For i = 0 To Dimension
        Coefficients(i) = -Coefficients(i)
    Next i
    x = -1#
    For i = 0 To Dimension
        x = x - Coefficients(i)
    Next i
    mju = mju * x
End Sub
'Вычисление оценки спектральной плотности по методу максимальной
'энтропии на частоте F
Private Function MEMSD(sigma As Double, F As Double) As Double
Dim Re, Im As Double
Dim i As Integer
    Re = 0
    Im = 0
    For i = 0 To Dimension
        Re = Re + Coefficients(i) * Cos(-i * F)
        Im = Im + Coefficients(i) * Sin(-i * F)
    Next i
    MEMSD = sigma / 2 / 3.1415926 / (Re * Re + Im * Im)
End Function
Sub Main()
Dim i
Dim x As Double, y As Double, ini As Double, fin As Double
Dim SI As Double, step As Double
    Sheets("Data").Activate
    Dimension = Cells(1, 4).Value
    ini = Cells(4, 4).Value: fin = Cells(3, 4).Value
    step = (fin - ini) / 399
    SI = Cells(6, 4).Value
    VectorLength = 0
    For Each i In Range("Sample")
        VectorLength = VectorLength + 1
        Vector(VectorLength) = i.Value
    Next i
    Call MEMCF(x, y)
    Cells(1, 5) = "Частота": Cells(1, 6) = "Период"
    Cells(1, 7) = "MEM cпектр"
    For i = 1 To 400
        Cells(i + 1, 5).Value = Format(ini + step * (i - 1), "0.000")
        y = MEMSD(x, ini + (i - 1) * step)
        Cells(i + 1, 7).Value = y
        If (ini + (i - 1) * step) < 1e-09 Then
            Cells(i + 1, 6).Value = "~"
        Else
            y = 2 * 3.1415926 * SI / (ini + (i - 1) * step)
            Cells(i + 1, 6).Value = Format(y, "0.00")
        End If
    Next i

End Sub