В рабочей книге nonlinear_equation.xls представлен вариант реализации рассмотренных методов.

Задание левой части нелинейного уравнения f(x)=0, интервала поиска корня и выбор численного метода решения реализовано с помощью диалогового окна.

Исходные данные могут задаваться как непосредственно, так и с помощью ссылок на ячейки электронной таблицы. Левая часть уравнения должна быть записана в соответствии с синтаксическими правилами MS Excel.

При запуске вычислительной процедуры осуществляется проверка корректности исходных данных (эта часть VBA кода не приведена в листинге ниже).

Полученные корни, выводятся в ячейки электронной таблицы (необходимо указать диапазон вывода корней). Для каждого найденного корня подсчитывается количество итераций. В случае отсутсвия корней в заданном промежутке выводится соответствующее сообщение.

Листинг

часть программного кода кнопки "Решить"

'////////////////////////////////////////////
'equat - строка, содержащая уравнение
'a - начальное значение х
'b - конечное значение х
'step - шаг
'f1 и f2 - значения функции в соседних точках
'eps - точность
'////////////////////////////////////////////

i = 1
If OptDih.Value Then 'выбран метод дихотомии

'выяснение наличия корня по изменению знака функции
For x = a + step To b Step step
f2 = sheetFormula(CStr(x), equat)

If (f1 * f2 < 0) Or (f2 = 0) Then 'корень найден
iter_count = 0
If Abs(f2) < eps Then 'корень не требует уточнения
Root.Cells(i) = x
Else
'уточнение корня методом дихотомии и вывод результата и количества итераций
Root.Cells(i) = dichotomy(x, x - step, f1, equat, eps)
End If
'вывод количества итераций
Root.Cells(i, 2) = "количество итераций =" & iter_count
i = i + 1
End If

f1 = f2
Next x
ElseIf OptChord.Value Then 'выбран метод хорд

'выяснение наличия корня по изменению знака функции
For x = a + step To b Step step
f2 = sheetFormula(CStr(x), equat)

If f1 * f2 < 0 Or (f2 = 0) Then 'корень найден
iter_count = 0
If Abs(f2) < eps Then 'корень не требует уточнения
Root.Cells(i) = x
Else
'уточнение корня методом хорд и вывод результата и количества итераций
Root.Cells(i) = chord(x, x - step, f1, f2, equat, eps)
End If
'вывод количества итераций
Root.Cells(i, 2) = "количество итераций =" & iter_count
i = i + 1
End If

f1 = f2
Next x

Else 'выбран метод секущих

'выяснение наличия корня по изменению знака функции
For x = a + step To b Step step
f2 = sheetFormula(CStr(x), equat)

If f1 * f2 < 0 Or (f2 = 0) Then 'корень найден
iter_count = 0
If Abs(f2) < eps Then 'корень не требует уточнения
Root.Cells(i) = x
Else
'уточнение корня методом секущих и вывод результата
Root.Cells(i) = secant(x, x - step, f1, equat, eps)
End If
'вывод количества итераций
Root.Cells(i, 2) = "количество итераций =" & iter_count
i = i + 1
End If
f1 = f2
Next x
End If

Программный код функций уточнения корней

' Функция нахождения уточненного значения корня с заданной точностью методом дихотомии
Function dichotomy(ByVal xn1 As Double, ByVal xn As Double, ByVal fn As Double, ByVal equat As String, ByVal eps As Double)
Do
'вычисление середины промежутка [xn, xn+1](хav) и значение функции в этой точке (fav)
xav = (xn + xn1) / 2
fav = sheetFormula(CStr(xav), equat)
If fav * fn < 0 Then 'знаки fav и fn одинаковы
xn1 = xav
fn1 = fav
Else ' fav и fn имеют разные знаки
xn = xav
fn = fav
End If
iter_count = iter_count + 1
Loop While Abs(fav) > eps 'обеспечивается ли заданная точность
dichotomy = xav
End Function

' Функция нахождения уточненного значения корня с заданной точностью методом хорд
Function chord(ByVal xn1 As Double, ByVal xn As Double, ByVal fn As Double, ByVal fn1 As Double, ByVal equat As String, ByVal eps As Double)
Do
'вычисление значения х* и значения функции в этой точке (f)
x = xn - fn * (xn1 - xn) / (fn1 - fn)
f = sheetFormula(CStr(x), equat)
If f * fn < 0 Then 'знаки f и fn одинаковы
xn1 = x
fn1 = f
Else 'f и fn имеют разные знаки
xn1 = x
fn1 = f
End If
iter_count = iter_count + 1
Loop While Abs(f) > eps 'обеспечивается ли заданная точность
сhord = x
End Function

' Функция нахождения уточненного значения корня с заданной точностью методом хорд
Function secant(ByVal xn1 As Double, ByVal xn As Double, ByVal fn As Double, ByVal equat As String, ByVal eps As Double)
r = xn1 - xn
d = fn
x = xn1
Do
fn1 = sheetFormula(CStr(x), equat)
r = r / (fn - fn1) * fn1
fn = fn1
secant = x
x = x + r
iter_count = iter_count + 1
Loop While Abs(fn1) > eps 'обеспечивается ли заданная точность
End Function

Пример

Найти решение уравнения 0,25X-sinX=0