Шаг 190.
VBA в MSExcel. Практические приемы программирования на VBA. Тема: решение уравнения, зависящего от параметра. Построение диаграммы. Практика

    На этом шаге мы рассмотрим основные моменты создания указанного приложения.

    Для решения задачи нахождения корней уравнения, зависящего от параметра, и построения диаграммы зависимости корней от параметра с помощью редактора пользовательских форм создадим диалоговое окно нелинейное уравнение с параметром (рисунок 1).


Рис.1. Диалоговое окно Нелинейное уравнение с параметром

    О решаемом уравнении предполагается, что оно преобразовано к виду, когда только левая часть зависит от неизвестной и параметра. Правая же часть — постоянна. При вводе левой части уравнения в поле ввода элемента управления RefEdit вместо переменной x надо давать ссылку на ячейку В2, а вместо параметра — А2. Кроме того, формула должна быть составлена по тем же правилам, по которым пишутся формулы рабочего листа. Например, для упомянутого выше уравнения в поле надо ввести:

  =B2^3-B2-A2
либо эквивалентную формулу с абсолютными ссылками на ячейки.

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

UserForm_Initialize
  1. Активизирует диалоговое окно.
  2. Назначает клавише Esc функцию кнопки Отмена, а клавише Enter - Вычислить.

Нажатие кнопки вычислить запускает на выполнение процедуру CommandButton1_Click
  1. При выполнении щелчка в соответствующей ячейке в поле элемента управления RefEdit вводится абсолютная ссылка на эту ячейку. При выделении ячейки с формулой и протаскивании ее маркера заполнения вниз вдоль столбца для получения корректного результата нужна не абсолютная, а относительная ссылка. С этой целью из строки с формулой, присвоенной строковой переменной Формула, удаляются все знаки $, тем самым превращая все абсолютные ссылки в относительные.
  2. Удаляются с рабочего листа ранее введенные данные и создаются заголовки полей отчета.
  3. Устанавливаются предельное число итераций и относительная погрешность метода GoalSeek.
  4. Методом DataSeries в диапазоне создается арифметическая профессия изменения значений параметра от начального до конечного значения с указанным шагом.
  5. Вводится начальное приближение в диапазон.
  6. Вводится в диапазон левая часть уравнения при различных значениях параметра.
  7. Последовательно для каждой ячейки, имеющей формулу с левой частью уравнения, методом GoalSeek, находится корень уравнения.
  8. Вызывается процедура ПостроениеГрафика для построения графика (рисунок 2).


    Рис.2. Отчет, выводимый на рабочем листе программой решения уравнения с параметром

Нажатие кнопки отмена запускает на выполнение процедуру CommandButton2_Click
Закрывает диалоговое окно.

Процедура ПостроениеГрафика
Строит график.

    Приведем полный текст приложения.

Private Sub CommandButton1_Click()
  ' Процедура нахождения корней уравнения с параметром
  Dim ПараметрНач As Double
  Dim ПараметрКон As Double
  Dim ПараметрШаг As Double
  Dim НачПрибл As Double
  Dim ПраваяЧасть As Double
  Dim Формула As String
  ' ПараметрНач - начальное значение параметра
  ' ПараметрКон - конечное значение параметра
  ' ПараметрШаг - шаг изменения параметра
  ' НачПрибл - начальное приближение корня, общее для всех
  ' значений параметра
  ' ПраваяЧасть - правая часть уравнения
  ' Формула - левая часть уравнения. Уравнение записывается так,
  ' что неизвестная входит только в левую часть, а
  ' правая часть - постоянна
  Dim i As Integer
  Dim Длина As Integer
  Dim n As Integer
  ' i, n, Длина - вспомогательные переменные

  ' Ввод исходных данных из диалогового окна
  With UserForm1
    ПараметрНач = CDbl(.TextBox1.Text)
    ПараметрКон = CDbl(.TextBox2.Text)
    ПараметрШаг = CDbl(.TextBox3.Text)
    НачПрибл = CDbl(.TextBox4.Text)
    Формула = Trim(CStr(.RefEdit1.Text))
    ПраваяЧасть = CDbl(.TextBox5.Text)
  End With

  ' Элемент управления RefEdit при вводе в него ссылок на ячейки
  ' щелчком в соответствующей ячейке возвращает абсолютные ссылки на
  ' эти ячейки.
  ' При протаскивании маркера заполнения выделенной ячейки,
  ' содержащей формулу левой части уравнения, вниз по столбцу
  ' для получения корректного результата необходима не абсолютная, а
  ' относительная ссылка. Для преобразования абсолютной ссылки в
  ' относительную ниже в операторе цикла Do-Loop из строки с формулой,
  ' присвоенной строковой переменной Формула, удаляются все знаки
  ' абсолютной ссылки $
  i = 1
  Do
    If Mid(Формула, i, 1) = "$" Then
      Длина = Len(Формула)
      Формула = Left(Формула, i - 1) + Right(Формула, Длина - i)
    Else
      i = i + 1
    End If
  Loop While i <= Len(Формула)

  ' Очистка трех первых столбцов рабочего листа
  Range("A:C").Clear

  ' Форматирование заголовка отчетной таблицы.
  ' Установка:
  '   ширины первых трех столбцов
  '   высоты первой строки
  '   выравнивание
  Range("A:A").ColumnWidth = 12
  Range("B:B").ColumnWidth = 14
  Range("C:C").ColumnWidth = 17
  Range("A1:C1").Select
  With Selection
    .RowHeight = 37
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlTop
    .WrapText = True
    .Font.Bold = True
    .Font.Size = 11
  End With

  ' Ввод заголовков трех первых столбцов рабочего листа
  Range("A1").Value = "Параметр"
  Range("B1").Value = "Переменная"
  Range("C1").Value = "Левая часть уравнения"

  ' Установка параметров метода Подбор параметра
  With Application
    .MaxIterations = 1000
    .MaxChange = 0.0001
  End With

  ' Ввод в столбец А значений параметра
  Range("A2").Value = ПараметрНач
  Range("A2").Select
  Selection.DataSeries Rowcol:=xlColumns, _
    Type:=xlLinear, Step:=ПараметрШаг, Stop:=ПараметрКон

  ' Определение числа заполненных строк
  n = Range("A2").CurrentRegion.Rows.Count

  ' Ввод в диапазон столбца В начального приближения
  Range(Cells(2, 2), Cells(n, 2)).Value = НачПрибл

  ' Ввод в диапазон столбца С левой части уравнения
  Range("C2").Formula = Формула
  Range("C2").AutoFill _
    Destination:=Range(Cells(2, 3), Cells(n, 3)), _
    Type:=xlFillDefault

  ' Последовательное решение уравнений с помощью команды Подбор параметра
  For i = 2 To n
    Cells(i, 3).GoalSeek Goal:=ПраваяЧасть, _
      ChangingCell:=Cells(i, 2)
  Next i

  ' Вызов процедуры для построения графика
  ПостроениеГрафика
End Sub
Private Sub CommandButton2_Click()
  ' Процедура закрытия диалогового окна
  UserForm1.Hide
End Sub
Private Sub UserForm_Initialize()
  ' Процедура активизации диалогового окна
  ' Клавише <Enter> назначена функция кнопки Вычислить.
  ' Клавише <Esc> назначена функция кнопки Отмена.
  CommandButton1.Default = True
  CommandButton2.Cancel = True
  UserForm1.Show
End Sub
Sub ПостроениеГрафика()
  ' Процедура построения графика
  Dim n As Integer
  ' n - число строк диапазона, по которому строится график
  Dim ДиапазонОсиY As Object
  Dim ДиапазонОсиХ As Object
  Dim ИмяДиаграммы As String
  Dim ДиапазонY As String
  Dim ДиапазонХ As String
  Dim ИмяЛиста As String

  n = ActiveSheet.Cells(1, 1).CurrentRegion.Rows.Count
  ИмяЛиста = ActiveSheet.Name

  ' Удаление всех ранее построенных диаграмм с. рабочего листа
  ActiveSheet.ChartObjects.Delete

  ' Создание новой диаграммы и установка ее типа
  Charts.Add
  ActiveChart.ChartType = xlLineMarkers

  ' Определение диапазона, отводимого под значения функции
  ДиапазонY = "B2:B" & LTrim(CStr(n))
  Set ДиапазонОсиY = Sheets(ИмяЛиста).Range(ДиапазонY)

  ' Определение диапазона, отводимого под значения аргумента
  ДиапазонХ = "A2:A" & LTrim(CStr(n))
  Set ДиапазонОсиХ = Sheets(ИмяЛиста).Range(ДиапазонХ)

  ' Построение графика
  ActiveChart.SetSourceData Source:=ДиапазонОсиY, PlotBy:=xlColumns
  ActiveChart.SeriesCollection(1).XValues = ДиапазонОсиХ
  ActiveChart.Location Where:=xlLocationAsObject, Name:=ИмяЛиста
  With ActiveChart
    .HasTitle = True
    .ChartTitle.Characters.Text = "Зависимость корня от параметра"
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Параметр"
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Корень"
  End With
  ActiveChart.HasLegend = False
  ИмяДиаграммы = ActiveSheet.ChartObjects(1).Name

' Перемещение диаграммы и изменение ее размеров
  ActiveSheet.Shapes(ИмяДиаграммы).ScaleHeight 1.17, msoFalse, _
    msoScaleFromBottomRight
  ActiveSheet.Shapes(ИмяДиаграммы).IncrementLeft 124.5
  ActiveSheet.Shapes(ИмяДиаграммы).IncrementTop -25.5
End Sub
Текст этого примера можно взять здесь.

    На следующем шаге мы закончим изучение этого вопроса.




Предыдущий шаг Содержание Следующий шаг