На этом шаге мы рассмотрим основные моменты создания указанного приложения.
Для решения задачи нахождения корней уравнения, зависящего от параметра, и построения диаграммы зависимости корней от параметра с помощью редактора пользовательских форм создадим диалоговое окно нелинейное уравнение с параметром (рисунок 1).
Рис.1. Диалоговое окно Нелинейное уравнение с параметром
О решаемом уравнении предполагается, что оно преобразовано к виду, когда только левая часть зависит от неизвестной и параметра. Правая же часть — постоянна. При вводе левой части уравнения в поле ввода элемента управления RefEdit вместо переменной x надо давать ссылку на ячейку В2, а вместо параметра — А2. Кроме того, формула должна быть составлена по тем же правилам, по которым пишутся формулы рабочего листа. Например, для упомянутого выше уравнения в поле надо ввести:
=B2^3-B2-A2
Обсудим, как приведенная ниже программа решает перечисленные задачи и что происходит в программе.
Рис.2. Отчет, выводимый на рабочем листе программой решения уравнения с параметром
Приведем полный текст приложения.
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
На следующем шаге мы закончим изучение этого вопроса.