Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автоматическое нахождение степени регрессии и величины достоверности аппроксимации (VBA)
 
#1
07.10.2015 12:58:30
Здравствуйте, подскажите пожалуйста как можно автоматизировать процесс нахождения  степени регрессии и  величины достоверности аппроксимации по данной таблице, что бы в результате была составлена итоговая таблица (см. пример).
В итоговой таблице столбики:
1. номер событя
2. Знак события -, если числа возрастают -  то "+", если убывают - то "-"
3. коэффициент регрессии - это b из уравнения  линейной линии тренда  (y=bx+a)
4. величина достоверности аппроксимации (R^2).
 
 
 
#2
07.10.2015 15:01:20
Alejandro67, если каждое событие занимает 4 строки + 1 пустую, то так (см. файл, ст. I:L). Сбой происходит на событии 70, которое занимает 6 строк. Если удалить одну строку из события 70, то можно протянуть формулы дальше.
Если число строк события может быть разным, то лучше макросом, а то формулы слишком сложные будут.
Насчет знака не понял, по-моему он определяется коэф-том регрессии. В примере получается только "+".
Изменено: Казанский - 07.10.2015 15:05:55 (упростил формулы)
 
 
 
#3
07.10.2015 15:08:30
Событие по длине может быть различным, от 3 ячеек и более
 
 
 
#4
07.10.2015 15:45:59
Alejandro67,
Код
Sub Alejandro67()
Dim a As Range, i&, r()
  Set a = Range("A3", Cells(Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeConstants)
  ReDim v(1 To a.Areas.Count, 1 To 4)
  For Each a In a.Areas
    i = i + 1
    v(i, 1) = a.Cells(1, 3)
    r = WorksheetFunction.LinEst(a.Columns(2), a.Columns(1), , 1)
    v(i, 3) = r(1, 1)
    v(i, 4) = r(3, 1)
    v(i, 2) = IIf(v(i, 3) > 0, "+", "-")
  Next
  [E3].Resize(UBound(v), 4).Value = v
End Sub
 
 
 
#5
07.10.2015 22:50:07
Супер, то что надо! Казанский, Спасибо
 
 
 
#6
07.10.2015 23:40:42
Казанский, При использовании макроса в другой книге (при условии что данные находятся в тех же самых местах), возникает ошибка: "НЕвозможно получить свойства LinEst класса WorksheetFunction"

Как это можно исправить?
 
 
 
#7
08.10.2015 00:00:01
Alejandro67, видимо, нечисловые данные в ст. А:В. Или "пустые строки" на самом деле не пустые. Приложите лист с частью данных, на которых возникает ошибка.
 
 
 
#8
08.10.2015 07:02:23
Казанский, вот пожалуйста, новый пример, где обнаруживается ошибка.  
 
 
 
#9
08.10.2015 10:09:00
Alejandro67, см. строки 160, 310. Поправил макрос, чтобы игнорировать нечисловые. И выходные данные сейчас не копятся в массиве, а сразу выводятся на лист, чтобы в случае ошибки Вы могли найти источник проблемы.
Код
Sub Alejandro67()
Dim a As Range, i&, r(), v(1 To 4)
  Set a = Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers)
  i = 3
  For Each a In a.Areas
    v(1) = a.Cells(1, 3)
    r = WorksheetFunction.LinEst(a.Offset(, 1), a, , 1)
    v(3) = r(1, 1)
    v(4) = r(3, 1)
    v(2) = IIf(v(3) > 0, "+", "-")
    Cells(i, "E").Resize(, 4).Value = v
    i = i + 1
  Next
End Sub
 
 
 
#10
09.10.2015 18:29:53
Казанский, Спасибо большое, все работает замечательно. Посоветуйте, с чего начать изучать vba, что бы писать такие замечательные макросы
 
 
 
Страницы: 1
Наверх