У12 4 Результат решения второй задачи
Рисунок У12.4. Результат решения второй задачи
'
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 CommandButtonl_Click()
' При выборе переключателя С повторениями
' производится расчет по процедуре ТрендСПовторениями,
' а при выборе переключателя.Без повторений
' производится расчет по процедуре ОбьиныйТренд
'
If OptionButtonl.Value = True Then ОбычныйТренд
End If
'
If OptionButton2.Value = True Then
ТрендСПовторениями
End If
'
End Sub
Private Sub CommandButton2_Click()
'
' Закрытие диалогового окна
'
UserForm1.Hide
End Sub
'
Private Sub OptionButtonl_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 = "Линейная регрессия" MultiPagel.Value = 0
CommandButton2.Cancel = True RefEddt3.Visible = False
Label3.Visible = False OptionButtonl.Value = True
UserForml.Show
End Sub
'
Sub ОбычныйТренд()
'
' Процедура расчета обычного тренда
'
' Ввод диапазонов данных
'
Независимая = RefEdit1.Value
Зависимая = RefEdit2.Value
' Проверка, располагаются ли данные в столбцах С или D.
' Если располагаются, то отображается соответствующее сообщение
If InStr(Range(Независимая).Address, "С") > 0 Or _ InStr(Range(Независимая).Address, "D") > 0 Then
MsgBox "Независимая переменная не может располагаться в" & Chr(13) & "столбцах С и D", vblnformation, "Линейная регрессия"
RefEditl.SetFocus
Exit Sub
End If
If InStr(Range(Зависимая).Address, "C") > 0 Or _ InStr(Range(Зависимая).Address, "D") > 0 Then
MsgBox "Зависимая переменная не может располагаться в" & Chr(13) & "столбцах С и D",
vblnformation, "Линейная регрессия" RefEdit2.SetFocus
Exit Sub
End If
'
' Проверка, располагаются ли данные только в столбцах,
' либо только в строках
'
If Range(Зависимая).Rows.Count > 1 And
Range(Зависимая).Columns.Count > 1 Then
MsgBox "Зависимая переменная должна располагаться " & Chr(13) & "либо в строке, либо в столбце", vblnformation, "Линейная регрессия" RefEdit2.SetFocus
Exit Sub
End If
'
If Range(Независимая).Rows.Count > 1 And _ Range(Независимая).Columns.Count > 1 Then
MsgBox "Независимая переменная должна располагаться" & Chr(13) & "либо в строке, либо в столбце",' vblnformation, "Линейная регрессия" RefEditl.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) & "либо в строках, либо в столбцах", vblnformation, "Линейная регрессия"
RefEditl.SetFocus
Exit Sub
End If
'
' Ввод на рабочий лист заголовков
'
Range("Cl").Value = "Отрезок=" Range("C2").Value = "Наклон="
Range("C3").Value = "R=" '
' Расчет коэффициентов линии тренда ' и коэффициента корреляции
Range("D1'") .FormulaLocal = "=OTPE30K(" & Зависимая & ";" & Независимая & ")"
Range("D2").FormulaLocal = "=НАКЛОН(" & Зависимая & ";" & Независимая & ")"
Range("D3") .FormulaLocal = "=KOPPEЛ(" & Зависимая & ";" & Независимая & ")" '
b = Range("Dl").Value m = Range("D2").Value Корреляция = Range("D3").Value
'
' Вывод данных в диалоговое окно
'
TextBoxl.Text = CStr(b) TextBox2.Text = CStr(m)
TextBox3.Text = CStr(Корреляция)
'
' Построение диаграммы по двум диапазонам: Независимая и Зависимая
'
Set НезависимаяЗависимая = _
Application.Union(Range(Независимая) , Range(Зависимая)) Диаграмма НезависимаяЗависимая
End Sub
'
Sub ТрендСПовторениями()
'
Dim ИмяЛиста As String
Dim Ячейка As Object
Dimx(), y(), Nxy(), Nx(), Ny() As Double
Dim i, j, k, p, N_x, N_y, Nобщая As Integer '
Независимая = RefEditl.Value '
If Range(Независимая).Columns.Count > 1 Then
MsgBox "Данные для независимой переменной" & Chr(13) & "должны располагаться в одном столбце", vblnformation, "Линейная регрессия"
Exit Sub
End If
'
For Each Ячейка In Range(Независимая).Cells
If IsNumeric(Ячейка.Value) = False Then
MsgBox "В ячейках данных для независимой" & Chr(13) & _
"переменной должны быть только числа", vblnformation, "Линейная регрессия"
Exit Sub
End If
Next Ячейка
'
Зависимая = RefEdit2.Value
'
If Range(Зависимая).Rows.Count > 1 Then
MsgBox "Данные для независимой переменной" & Chr(13) & "должны располагаться в одной строке", vblnformation, "Линейная регрессия"
Exit Sub
End If '
For Each Ячейка In Range(Зависимая).Cells
If IsNumeric(Ячейка.Value) = False Then
MsgBox "В ячейках данных для зависимой" & Chr(13) & "переменной должны быть только числа", vblnformation, "Линейная регрессия"
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) & "согласованы с диапазонами данных наблюдаемых величин ", vblnformation, "Линейная регрессия"
Exit Sub
End If
For Each Ячейка In Range(Повторения).Cells
If IsNumeric(Ячейка.Value) - False Then
MsgBox "В ячейках данных таблицы повторений" & Chr(13) & "переменной должны быть только числа", vblnformation, "Линейная регрессия"
Exit Sub
End If
Next Ячейка
ReDim Nxy(1 To N_x, 1 To N_y) , Nx(l To N_x) , Ny(l To N_y) ,
x(l 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 То N_x
Ыобщая = Ыобщая + Nx(i)
Next i
'
' Ыобщая - число наблюдений
For j = 1 То 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
' Записывание значений зависимой и независимой переменной ' в два столбца с учетом повторений
'
Р = 1
For i = 1 То N_x
For j = 1 То 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
'
TextBoxl.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:=l, 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
