Страницы: 1
RSS
Определение коэффициентов тренда в программе
 
Добрый день уважаемые.
Собственно вопрос.
Для определения коэффициентов полинома тренда в экселе используется структура:
Код
=ИНДЕКС(ЛИНЕЙН($B$2:$B$37;$A$2:$A$37^{1;2;3});1) 
- в данном случае я получаю 1-й коэф.кубической апроксимации данных

А как такое сделать в программе?
Пробовал делать так
Код
Public Function Popravka3(parametr As Single, krit As Single) As Single

' Задаю массивы из четырёх элементов. Т.е. у нас четыре графика
Dim kriv(0 To 3) As Currency
Dim kritgraf(0 To 3) As Currency

' Коэффициенты полинома
Dim koefA As Currency
Dim koefB As Currency
Dim koefC As Currency
Dim koefD As Currency

' ввести уравнения кривых и критерии относящиеся к кривым. Уравнения в качестве примера.
kriv(0) = 2 * parametr + 3
kritgraf(0) = 100
kriv(1) = 3 * parametr + 3
kritgraf(1) = 100
kriv(2) = 4 * parametr + 3
kritgraf(2) = 100
kriv(3) = 5 * parametr + 3
kritgraf(3) = 100

' Собственно расчёт. Интерполяция кубическим сплайном (по трём кривым).
 koefA = INDEX(LINEST(kriv,kritgraf^{1,2,3}),1,1)
 koefB = INDEX(LINEST(kriv,kritgraf^{1,2,3}),1,2)
 koefC= INDEX(LINEST(kriv,kritgraf^{1,2,3}),1,3)
 koefD= INDEX(LINEST(kriv,kritgraf^{1,2,3}),1,4)
  
 Popravka3 = koefA * krit * krit * krit + koefB * krit* krit  + koefC* krit + koefD 
End Function

не выходит - не понимает VBA такую структуру... Делать через макрос не хочу - есть желание иметь функцию пользователя.
 
tutochkin,
https://www.planetaexcel.ru/forum/?PAGE_NAME=read&FID=1&TID=48049
еще https://www.google.com/search?q=worksheetfunction.linest+site%3Aplanetaexcel.ru

То есть у Вас два пути. Если массивы короткие, как в примере, можно перевести их в текстовый вид и использовать Evaluate, например для parametr=1 получится
Код
arrResult = Evaluate("LINEST({5;6;7;8},{100;100;100;100}^{1,2,3})")

Либо использовать Worksheetfunction.Linest как нормальную функцию VBA, тогда придется сформировать двумерный массив для второго аргумента в коде.
Еще - Linest возвращает массив, см. Справку. Не надо вызывать ее несколько раз с теми же аргументами. Вызовите один раз и извлеките из массива нужные элементы.
 
Моя старая старая тема.

Если кто то ищет, то я использую вот такой вариант пользовательской программы, чтобы в очередной раз велосипед не изобретали.
Код
' Проведение интерполяции с использованием функционала Excel
' На выходе - коэффициенты полинома. Число точек должно быть минимум на одну больше, чем степень полинома.
' Данные берутся из программы
Public Sub Linia_trenda(ByRef Y() As Double, ByRef X() As Double, ByVal PolyStep As Integer, ByRef c() As Double, Optional ByRef r2 As Double)
    Dim stepen As Long
    ' Ввожу проверку не превышения степени массива
    If (UBound(Y) - LBound(Y) - 1) < PolyStep Then
        stepen = UBound(Y) - LBound(Y)
    Else
        stepen = PolyStep
    End If
    ' Объявляю переменные, создаю матрицы под размер данных и степень полинома.
    Dim X1() As Double, y1() As Double
    ReDim X1(LBound(Y) To UBound(Y), 1 To stepen) As Double
    ReDim y1(LBound(Y) To UBound(Y), 1 To 1) As Double
    ReDim c(1 To stepen + 1) As Double
    ' Заполню массив Х в соответствии со степенью уравнения.
    For i = LBound(X) To UBound(X)
        y1(i, 1) = Y(i)
        X1(i, 1) = X(i)
        For N = 2 To stepen
            X1(i, N) = X1(i, 1) ^ N
        Next N
    Next i
    ' Нахожу уравнение.
    Dim Coefs As Variant
        Coefs = WorksheetFunction.LinEst(y1, X1, True, True)
    ' Вытаскиваю коэффициенты полинома.
    For i = 1 To stepen + 1
        c(i) = Coefs(1, i)
    Next i
    ' Вытаскиваю величину достоверности аппроксимации.
    r2 = Coefs(3, 1)
End Sub
Страницы: 1
Наверх