Самоучитель VBA

       

Практика


В редакторе форм создадим диалоговое окно линейная регрессия (рис. У12.1). Это окно состоит из двух вкладок тренд и параметры (рис. У12.2).

Рис. У12.1. Вкладка Тренд диалогового окна Линейная регрессия

Рис. У12.2. Вкладка Параметры диалогового окна Линейная регрессия

Обсудим, как приведенная ниже программа решает описанную задачу и что в ней происходит.



UserForm Initialize

  1. Активизирует диалоговое окно.

    В начальном состоянии выбран переключатель Без повторений, что обеспечивает скрытие надписи повторения соответствующим полем.

Нажатие кнопки ок запускает на выполнение процедуру

CommandButtonl Click

При выборе переключателя с повторениями производит расчет по процедуре трендсповто-рениями (вторая задача), а при выборе переключателя Без повторений - по процедуре Обыч-ныйтренд (первая задача).

Нажатие кнопки выход запускает на выполнение процедуру

CommandButton2 Click

Закрывает диалоговое окно.

OptionButton1_Click

и

OptionButton2_Click

Обеспечивает скрытие и отображение в диалоговом окне надписи повторения и соответствующего поля.

ОбычныйТренд

  1. В поля Независимая величина (в данном Случае Температура) и Зависимая величина (объем продаж) вводит ссылки на диапазоны, по которым строится линия тренда. Исходя из рис. У 12.3 В Поле Независимая величина вводится ссылка на диапазон А2:А7, а в поле Зависимая величина — В2 : В7 .

  2. Проверяет, располагаются ли данные только в столбцах, либо только в строках. Также проверяет, располагаются ли данные в столбцах с или D (эти два столбца зарезервированы программой для вывода результатов расчета). Если располагаются, то отображается соответствующее сообщение.
  3. На рабочий лист вводятся функции рабочего листа НАКЛОН, ОТРЕЗОК и КОРРЕЛ, по которым вычисляются параметры линии тренда и коэффициент корреляции.
  4. При помощи процедуры диаграмма строится диаграмма и линия тренда.

Рис. У 12.3. Результат решения первой задачи

ТрендСПовторениями В поля Независимая величина (в данном случае температура) и зависимая величина (объем продаж) вводит ссылки на диапазоны, по которым строится линия тренда. Исходя из рис. У 12. 4 в поле Независимая величина вводится ссылка на диапазон А2:А9, в поле Зависимая величина — В1:Н1, 3 в поле Повторения — В2:Н9

В остальном процедура действует аналогично процедуре обычныйТренд за исключением того, что перед вычислением параметров уравнения тренда она:

  • Находит число повторений каждой наблюдаемой величины, общее число всех наблюдений и выводит эти результаты в диапазоны, сопряженные с диапазоном, введенным в поле повторения .

    Преобразует наблюдения в таблицу из двух столбцов с учетом повторения наблюдений.

  • Диаграмма

    Строит диаграмму и линию тренда по диапазону, заданному в аргументе диапазон.

    <


    Рис. У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




    Содержание раздела