Option Explicit
' Переменные уровня модуля
Dim Независимая As String
Dim Зависимая As String
Dim Повторения As String
Dim НезависимаяЗависимая As Object
Dim Корреляция As Double
Dim m As Double
Dim b As Double

Private Sub CommandButton1_Click()
  ' При выборе переключателя С повторениями
  ' производится расчет по процедуре ТрендСПовторениями,
  ' а при выборе переключателя Без повторений
  ' производится расчет по процедуре ОбычныйТренд

  If OptionButton1.Value = True Then
    ОбычныйТренд
  End If

  If OptionButton2.Value = True Then
    ТрендСПовторениями
  End If

End Sub


Private Sub CommandButton2_Click()
  ' Закрытие диалогового окна
  UserForm1.Hide
End Sub

Private Sub OptionButton1_Click()
  ' Обеспечивается скрытие надписи Повторения и RefEdit3
  ' при выборе переключателя Без повторений
  RefEdit3.Visible = False
  Label3.Visible = False
End Sub


Private Sub OptionButton2_Click()
  ' Обеспечивается видимость надписи Повторения и RefEdit3
  ' при выборе переключателя С повторениями
  RefEdit3.Visible = True
  Label3.Visible = True
End Sub

Private Sub UserForm_Initialize()
  ' Активизация диалогового окна
  Caption = "Линейная регрессия"
  MultiPage1.Value = 0
  CommandButton2.Cancel = True
  RefEdit3.Visible = False
  Label3.Visible = False
  OptionButton1.Value = True
  UserForm1.Show
End Sub

Sub ОбычныйТренд()
  ' Процедура расчета обычного тренда

  ' Ввод диапазонов данных
  Независимая = RefEdit1.Value
  Зависимая = RefEdit2.Value

  ' Проверка, располагаются ли данные в столбцах С или D.
  ' Если располагаются, то отображается соответствующее сообщение
  If InStr(Range(Независимая).Address, "C") > 0 Or _
      InStr(Range(Независимая).Address, "D") > 0 Then
    MsgBox "Независимая переменная не может располагаться в" & Chr(13) _
        & "столбцах С и D", vbInformation, "Линейная регрессия"
    RefEdit1.SetFocus
    Exit Sub
  End If

  If InStr(Range(Зависимая).Address, "C") > 0 Or _
      InStr(Range(Зависимая).Address, "D") > 0 Then
    MsgBox "Зависимая переменная не может располагаться в" & Chr(13) & _
      "столбцах С и D", _
      vbInformation, "Линейная регрессия"
    RefEdit2.SetFocus
    Exit Sub
  End If

  ' Проверка, располагаются ли данные только в столбцах,
  ' либо только в строках
  If Range(Зависимая).Rows.Count > 1 And _
      Range(Зависимая).Columns.Count > 1 Then
    MsgBox "Зависимая переменная должна располагаться " & Chr(13) & _
      "либо в строке, либо в столбце", vbInformation, _
      "Линейная регрессия"
    RefEdit2.SetFocus
    Exit Sub
  End If

  If Range(Независимая).Rows.Count > 1 And _
      Range(Независимая).Columns.Count > 1 Then
    MsgBox "Независимая переменная должна располагаться" & Chr(13) & _
      "либо в строке, либо в столбце", vbInformation, _
      "Линейная регрессия"
    RefEdit1.SetFocus
    Exit Sub
  End If

  If (Range(Независимая).Rows.Count > 1 And _
        Range(Зависимая).Columns.Count > 1) Or _
        (Range(Независимая).Columns.Count > 1 And _
        Range(Зависимая).Rows.Count > 1) Then
    MsgBox "Независимая и Зависимая переменные должны располагаться " & Chr(13) & _
      "либо в строках, либо в столбцах", vbInformation, "Линейная регрессия"
    RefEdit1.SetFocus
    Exit Sub
  End If

  ' Ввод на рабочий лист заголовков
  Range("C1").Value = "Отрезок="
  Range("C2").Value = "Наклон="
  Range("C3").Value = "R="

  ' Расчет коэффициентов линии тренда
  ' и коэффициента корреляции
  Range("D1").FormulaLocal = "=ОТРЕЗОК(" & Зависимая & ";" & Независимая & ")"
  Range("D2").FormulaLocal = "=НАКЛОН(" & Зависимая & ";" & Независимая & ")"
  Range("D3").FormulaLocal = "=КОРРЕЛ(" & Зависимая & ";" & Независимая & ")"
  b = Range("D1").Value
  m = Range("D2").Value
  Корреляция = Range("D3").Value

  ' Вывод данных в диалоговое окно
  TextBox1.Text = CStr(b)
  TextBox2.Text = CStr(m)
  TextBox3.Text = CStr(Корреляция)

  ' Построение диаграммы по двум диапазонам: Независимая и Зависимая
  Set НезависимаяЗависимая = _
    Application.Union(Range(Независимая), Range(Зависимая))
  Диаграмма НезависимаяЗависимая
End Sub

Sub ТрендСПовторениями()
  Dim ИмяЛиста As String
  Dim Ячейка As Object
  Dim x(), y(), Nxy(), Nx(), Ny() As Double
  Dim i, j, k, p, N_x, N_y, Nобщая As Integer

  Независимая = RefEdit1.Value
  If Range(Независимая).Columns.Count > 1 Then
    MsgBox "Данные для независимой переменной" & Chr(13) & _
      "должны располагаться в одном столбце", vbInformation, "Линейная регрессия"
    Exit Sub
  End If

  For Each Ячейка In Range(Независимая).Cells
    If IsNumeric(Ячейка.Value) = False Then
      MsgBox "В ячейках данных для независимой" & Chr(13) & _
        "переменной должны быть только числа", vbInformation, "Линейная регрессия"
      Exit Sub
    End If
  Next Ячейка

  Зависимая = RefEdit2.Value
  If Range(Зависимая).Rows.Count > 1 Then
    MsgBox "Данные для независимой переменной" & Chr(13) & _
       "должны располагаться в одной строке", vbInformation, "Линейная регрессия"
    Exit Sub
  End If

  For Each Ячейка In Range(Зависимая).Cells
    If IsNumeric(Ячейка.Value) = False Then
      MsgBox "В ячейках данных для зависимой" & Chr(13) & _
         "переменной должны быть только числа", vbInformation, "Линейная регрессия"
      Exit Sub
    End If
  Next Ячейка

  Повторения = RefEdit3.Value
  N_x = Range(Повторения).Rows.Count
  N_y = Range(Повторения).Columns.Count

  ' N_x - число различных реализаций независимой переменной
  ' N у - число различных реализаций зависимой переменной
  If Range(Независимая).Columns.Count = N_x And _
         Range(Зависимая).Rows.Count = N_y Then
    MsgBox "Размеры таблицы повторений должны быть" & Chr(13) & _
       "согласованы с диапазонами данных наблюдаемых величин ", _
       vbInformation, "Линейная регрессия"
    Exit Sub
  End If

  For Each Ячейка In Range(Повторения).Cells
    If IsNumeric(Ячейка.Value) = False Then
      MsgBox "В ячейках данных таблицы повторений" & Chr(13) & _
          "переменной должны быть только числа", vbInformation, _
          "Линейная регрессия"
      Exit Sub
    End If
  Next Ячейка

  ReDim Nxy(1 To N_x, 1 To N_y), Nx(1 To N_x), Ny(1 To N_y), _
    x(1 To N_x), y(1 To N_y)

  For i = 1 To N_x
    For j = 1 To N_y
      Nxy(i, j) = Range(Повторения).Cells(i, j).Value
    Next j
  Next i

  For i = 1 To N_x
    Nx(i) = 0

    For j = 1 To N_y
      Nx(i) = Nx(i) + Nxy(i, j)
    Next j

    Range(Повторения).Cells(i, N_y).Select
    Selection.Offset(0, 1).Value = Nx(i)
  Next i

  ' Nx(i) - число повторений i-го значения независимой переменной '
  Nобщая = 0

  For i = 1 To N_x
    Nобщая = Nобщая + Nx(i)
  Next i

  ' Nобщая - число наблюдений
  For j = 1 To N_y
    Ny(j) = 0

    For i = 1 To N_x
      Ny(j) = Ny(j) + Nxy(i, j)
    Next i

    Range(Повторения).Cells(N_x, j).Select
    Selection.Offset(1, 0).Value = Ny(j)
  Next j

  ' Ny(j) - число повторений i-го значения зависимой переменной
  Range(Повторения).Cells(N_x, N_y).Select
  Selection.Offset(1, 1).Value = Nобщая

  ' x(i) - i-e значение независимой переменной
  For i = 1 To N_x
    x(i) = Range(Независимая).Cells(i).Value
  Next i

  ' y(i) - i-e значение зависимой переменной
  For i = 1 To N_y
    y(i) = Range(Зависимая).Cells(i).Value
  Next i

  ' Записывание значений зависимой и независимой переменной
  ' в два столбца с учетом повторений
  p = 1
  For i = 1 To N_x
    For j = 1 To N_y
      If Nxy(i, j) <> 0 Then
        For k = 1 To Nxy(i, j)
          Cells(p, 100).Value = x(i)
          Cells(p, 101).Value = y(j)
          p = p + 1
        Next k
      End If
    Next j
  Next i

Независимая = "R1C100:R" & CStr(p - 1) & "C100"
Зависимая = "R1C101:R" & CStr(p - 1) & "C101"

' Расчет коэффициентов линии тренда
' и коэффициента корреляции
  Cells(1, 102).FormulaLocal = "=ОТРЕЗОК(" & Зависимая & ";" & Независимая & ")"
  Cells(2, 102).FormulaLocal = "=НАКЛОН(" & Зависимая & ";" & Независимая & ")"
  Cells(3, 102).FormulaLocal = "=КОРРЕЛ(" & Зависимая & ";" & Независимая & ")"

  b = Cells(1, 102).Value
  m = Cells(2, 102).Value
  Корреляция = Cells(3, 102).Value

  TextBox1.Text = CStr(b)
  TextBox2.Text = CStr(m)
  TextBox3.Text = CStr(Корреляция)

  ' Построение диаграммы
  Диаграмма Range(Cells(1, 100), Cells(p - 1, 101))
End Sub

Sub Диаграмма(Диапазон As Object)
  ' Построение диаграммы по диапазону

  ActiveSheet.ChartObjects.Delete
  ActiveSheet.ChartObjects.Add(150, 49.25, 259.5, 169.5).Select
  Application.CutCopyMode = False

  ActiveChart.ChartWizard Source:=Диапазон, Gallery:=xlXYScatter, Format:=1, _
    PlotBy:=xlColumns, CategoryLabels:=1, SeriesLabels:=0, HasLegend:=False, _
    Title:="", CategoryTitle:="", _
    ValueTitle:="", ExtraTitle:=""

  ' Добавление в диаграмму линии тренда
  ActiveSheet.ChartObjects(1).Activate
  ActiveChart.SeriesCollection(1).Select
  ActiveChart.SeriesCollection(1).Trendlines.Add(Type:=xlLinear, _
    Forward:=0, Backward:=0, DisplayEquation:=True, _
    DisplayRSquared:=True).Select
End Sub