Практика

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

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

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

=В2^3-В2-А2

либо эквивалентную формулу с абсолютными ссылками на ячейки.

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

	UserForm_Initialize		Активизирует диалоговое окно. Назначает клавише <Esc> функцию кнопки отмена, а клавише <Enter> - вычислить.
	Нажатие кнопки вычислить запускает на выполнение процедуру CommandButtonl_Click		При выполнении щелчка в соответствующей ячейке в поле элемента управления Re f Edit вводится абсолютная ссылка на эту ячейку. При выделении ячейки с формулой и протаскивании ее маркера заполнения вниз вдоль столбца для получения корректного результата нужна не абсолютная, а относительная ссылка. С этой целью из строки с формулой, присвоенной строковой переменной Формула, удаляются все знаки $, тем самым превращая все абсолютные ссылки в относительные. Удаляются с рабочего листа ранее введенные данные и создаются заголовки полей отчета. Устанавливаются предельное число итераций и относительная погрешность метода Goal Seek. Методом DataSeries в диапазоне создается арифметическая профессия изменения значений параметра от начального до конечного значения с указанным шагом. Вводится начальное приближение в диапазон. Вводится в диапазон левая часть уравнения при различных значениях параметра. Последовательно для каждой ячейки, имеющей формулу с левой частью уравнения, методом GoalSeek, находится корень уравнения. Вызывается процедура ПостроениеГрафика для построения графика (рис. У5.2).
	Нажатие кнопки отмена запускает на выполнение процедуру CommandButton2 _Click		11 . Закрывает диалоговое окно.
	Процедура ПостроениеГрафика		12. Строит график.

<




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

Private Sub CommandButtonl_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 UserForml

ПарамётрНач = CDbl(.TextBoxl.Text)

ПараметрКон = CDbl(.TextBox2.Text)

ПараметрШаг = CDbl(.TextBox3.Text)

НачПрибл = CDbl(.TextBox4.Text)

Формула = Trim(CStr(.RefEditl.Text))

ПраваяЧасть = CDbl(.TextBox5.Text)

End With

'

' Элемент управления RefEdit при вводе в него ссылок на ячейки

' щелчком в соответствующей ячейке возвращает абсолютные ссылки на

' эти ячейки.

' При протаскивании маркера заполнения выделенной ячейки,

' содержащей формулу левой части уравнения, вниз по столбцу

' для получения корректного результата необходима не абсолютная, а

' относительная ссылка. Для преобразования абсолютной ссылки в

' относительную ниже в операторе цикла Do-Loop из строки с формулой,

' присвоенной строковой переменной Формула, удаляются все знаки

' абсолютной ссылки $

'

i = l Do

If Mid(Формула, i, 1) = "$" Then Длина = Len(Формула)

Формула = Left(Формула, i - 1) + Right(Формула, Длина - i)

Else

i = i + 1

End If

Loop While i <= Len(Формула)

'

' Очистка трех первых столбцов рабочего листа

'

Range("А:С").Clear



' Форматирование заголовка отчетной таблицы.

' Установка:

' ширины первых трех столбцов высоты первой строки

выравнивание

'

Range("A:A").ColumnWidth = 12

Range("В:В").ColumnWidth = 14

Range("С:С").ColumnWidth = 17

Range("Al:Cl").Select With Selection

.RowHeight = 37

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlTop

.WrapText = True

.Font.Bold = True

.Font.Size = 11

End With '

' Ввод заголовков трех первых столбцов рабочего листа

'

Range("Al").Value = "Параметр" Range("Bl").Value = "Переменная"

Range("Cl").Value = "Левая часть уравнения"

'

' Установка параметров метода Подбор параметра

With Application

.Maxlterations = 1000

.MaxChange = 0.0001 End With

'

' Ввод в столбец А значений параметра

Range("A2")-Value = ПараметрНач

Range("A2").Select

Selection.DataSeries Rowcol:=xlColurnns,

Type:=xlLinear, Step:=napaметpШaг, Stop:=napaметpKoн

'

' Определение числа заполненных строк

n = Range ("A2") .Current-Region.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 То n

Cells(i, 3).GoalSeek Goal:=ПраваяЧасть,

ChangingCell:=Cells(i, 2) Next i

' Вызов процедуры для построения графика

'

ПостроениеГрафика

'

End Sub

Private Sub CommandButton2_Click()

'

' Процедура закрытия диалогового окна

'

UserForml.Hide

End Sub

'

Private Sub UserForm_Initialize()

'

' Процедура активизации диалогового окна

' Клавише <Enter> назначена функция кнопки Вычислить.

' Клавише <Esc> назначена функция кнопки Отмена.



CommandButtonl.Default = True CommandButton2.Cancel = True

UserForml.Show

End Sub

'

Sub ПостроениеГрафика()

' Процедура построения графика

'

Dim n As Integer

' n - число строк диапазона, по которому строится график

Dim ДиапазонОсиY As Object

Dim ДиапазонОсиХ As Object

Dim ИмяДиаграммы As String

Dim Диапазону As String

Dim ДиапазонХ As String

Dim ИмяЛиста As String

n = ActiveSheet.Cells(1, 1).CurrentRegion.Rows.Count

'

ИмяЛиста = ActiveSheet.Name

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

ActiveSheet.ChartObj ects.Delete

' Создание новой диаграммы и установка ее типа

Charts.Add

ActiveChart.ChartType = xlLineMarkers

'

' Определение диапазона, отводимого под значения функции

'

Диапазону = "В2:В" & LTrim(CStr(n)}

Set ДиапазонОсиУ = Sheets(ИмяЛиста).Range(Диапазону)

'

' Определение диапазона, отводимого под значения аргумента

ДиапазонХ = "А2:А" & LTrim(CStr(n))

Set ДиапазонОсиХ = Sheets(ИмяЛиста).Range(ДиапазонХ)

'

' Построение графика

'

ActiveChart.SetSourceData

Source:=ДиапазонОсиY,

PlotBy:=xlColumns

ActiveChart.SeriesCollection(l).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

Процедура построениеграфика выглядит довольно громоздкой.


При ее написании лучше всего воспользоваться MacroRecorder, который переведет производимые пользователем вручную действия по построению диаграммы на язык VBA. Итак, для активизации MacroRecorder выберите команду Сервис, Макрос, Начать запись (Tools, Macro, Record New Macro) и запустите MacroRecorder на запись. После задания всех параметров в появившемся диалоговом окне Запись макроса (Record Macro) и нажатия кнопки ОК появится плавающая панель инструментов с кнопкой Остановить запись (Stop Recording). Теперь все производимые действия будут записываться до тех пор, пока не будет нажата эта кнопка. Постройте диаграмму по следующему алгоритму:

Нажмите кнопку Мастер диаграмм (Chart Wizard) панели инструментов Стандартная (Standard).

В появившемся окне первого шага мастера диаграм_м на вкладке Стандартные (Standard Types) в списке Тип (Chart type) выберите График (Line), а в группе Вид (Chart sub-type) - четвертый элемент. Нажмите кнопку Далее > (Next >).

В появившемся окне второго шага мастера диаграмм на вкладке Диапазон данных (Data Range) выберите переключатель Ряды в столбцах (Series in Columns) и в поле Диапазон (Data range) введите ссылку на диапазон =лист1! $в$2:$в$12, отводимый под значения функции, график которой строится. В поле Подписи оси X (Category (X) axis labels) вкладки Ряд (Series) введите ссылку на диапазон =лист1 !$д$2:$д$12, отводимый под значения аргумента. Нажмите кнопку Далее > (Next >).

В появившемся окне третьего шага мастера диаграмм на вкладке Заголовки (Titles) в поле Название диаграммы (Chart title) введите зависимость корня от параметра, в поле Ось X (категорий) (Category (X) axis) - - Параметр, в поле Ось Y (значений) (Category (Y) axis) - корень. На вкладке Легенда (Legent) снимите флажок Добавить легенду (Show Legent). Нажмите кнопку Далее > (Next >).

В появившемся окне четвертого шага мастера диаграмм в группе Поместить диаграмму на листе (Place chart) выберите переключатель имеющемся (As object in). Нажмите кнопку Готово (Finish).

В построенной диаграмме ухватитесь за маркер изменения размера и увеличьте размер диаграммы. После этого, ухватившись за маркер переноса, переместите диаграмму в требуемое место на рабочем листе.

Перечисленные выше действия будут переведены MacroRecorder в следующий макрос.

Sub Макрос1() '

' Макрос1 Макрос

' Макрос запиг.лн 27.04.99 (Андрей)

Charts.Add

AcliveChart.ChartType = xlLineMarkers

ActiveChart.SetSourceData _

Source:=Sheets("Лист!").Range("B2:В12"),

PlotBy:=xlColumns

ActiveChart.SeriesCollection(1).XValues = "=Лист1!R2C1:R12C1"

ActiveChart.Location Where:=xlLocationAsObject, Name:="Лиcтl" With

ActiveChart

.HasTitle = False

.Axes(xlCategory, xlPrimary).HasTitle = False

.Axes(xlValue, xlPrimary).HasTitle = False

End With

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

ActiveSheet.ChartObjects("Диагр. 14")

.Activate ActiveChart.ChartArea.Select

ActiveSheet.Shapes("Диагр. 14")

.ScaleHeight 1.17, msoFalse,

msoScaleFromBottomRight

ActiveSheet.Shapes("Диагр. 14")

.IncrementLeft 124.5

ActiveSheet.Shages("Диагр. 14")

.IncrementTop -25.5

End Sub

He трудно заметить, что данный макрос построения диаграмм сильно привязан к конкретному диапазону данных, рабочему листу и имени диаграммы. В процедуре построениеГрафика этот макрос существенно видоизменен для того, чтобы избавиться от этих обременительных ограничений. Кроме того, в ней предусмотрено удаление всех ранее построенных на рабочем листе диаграмм с тем, чтобы они не наслаивались друг на друга при многократном запуске приложения на одном и том же рабочем листе.

Процесс создания процедур для построения графиков с использованием MacroRecorder, особенно для избавления процедуры от привязки к конкретному диапазону данных, рабочему листу и имени диаграммы, кому-то может показаться излишне искусственным.


Им советуем для построения графиков использовать метод chartwizard, дающий более быстрый путь к цели. Ниже приведены необходимые изменения в процедуре построение-Графика для метода chartwizard. Уже поверхностное сравнение старой и новой версий процедуры построениеГрафика показывает, что благодаря методу chartwizard процедура стала компактнее. Кроме того, теперь она использует меньше вспомогательных переменных, необходимых при построении диаграммы.

Sub ПостроениеГрафика()

' Процедура построения графика

'

Dim n As Integer

'

'

' n - число строк диапазона, по которому строится график

'

n = ActiveSheet.Cells(1, 1).CurrentRegion.Rows.Count

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

'

ActiveSheet.ChartObjects.Delete

' (195, 30, 200, 190) - координаты области, где строится диаграмма

'

ActiveSheet.ChartObjects.Add(195, 30, 200, 190).Select

'

' Построение диаграммы

ActiveChart.Chartwizard Source:= _

Range(Cells(2, 1), Cells(n, 2)),

Gallery:=xlLine, Format:=4, PlotBy:=xlColumns,

CategoryLabels:=l, SeriesLabels:=0, HasLegend:=False,

Title:="3ависимость корня от параметра",

CategoryTitle:="Параметр",

ValueTitle:="KopeHb", ExtraTitle:="" End Sub




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

---

---