1. Программа процедуры вычисления корня

На основе Блок-схемы была написана процедура Koren.

Private Sub koren(pred As Integer, a As Single, b As Single, eps As Single, xw As Single, it As Integer, Flag As Boolean)

Dim xn1 As Single, xn2 As Single, xs As Single

Dim fxn1 As Single, fxn2 As Single, fxs As Single

Dim d As Single, Bool As Boolean

xn1 = a

xn2 = b

it = 0

fxn1 = f(xn1) ' вызов функции f для расчета ее значения в точке xn1

fxn2 = f(xn2) ' вызов функции f для расчета ее значения в точке xn2

Do

xs = (xn1 + xn2) / 2 ' вычисление xs

fxs = f(xs)

it = it + 1

Bool = Sgn(fxs) = Sgn(fxn2)

' функция sgn() сравнивает значение арнумента с нулем

If Bool Then

' если знак fxs и fxn2 совпадают, то конец отрезка переносим в точку xs

d = xn2 - xs

xn2 = xs

fxn2 = fxs

Else

' если знак fxs и fxn2 не совпадают, то конец отрезка переносим в точку xs

d = xs - xn1

xn1 = xs

fxn1 = fxs

End If

Bool = Abs(d) < eps Or it > pred

Loop Until Bool

'если |d|< или превышено количество итераций, цикл заканчивается

If it <= pred Then

Flag = False

xw = xs

Else

Flag = True

End If

End Sub

2. Главная программа

Процедура описания переменных.

Option Explicit

Dim Задано_a As Boolean

Dim Задано_b As Boolean

Dim Задано_eps As Boolean

Dim a As Single, b As Single

Dim eps As Single

При нажатии кнопки «Выход» происходит выход из программы.

Private Sub cmdВыход_Click()

End

End Sub

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

Private Sub UserForm_Activate()

Задано_a = False

Задано_b = False

Задано_eps = False

Txta.SetFocus

End Sub

Процедуры ввода начальных данных для выполнения расчетов.

Private Sub Txta_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 13 Then

a = Txta.Text

Задано_a = True

LblСообщ.Visible = False

Txtb.SetFocus

End If

End Sub

Private Sub Txtb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 13 Then

b = Txtb.Text

Задано_b = True

LblСообщ.Visible = False

Txteps.SetFocus

End If

End Sub

Private Sub Txteps_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 13 Then

eps = Txteps.Text

Задано_eps = True

LblСообщ.Visible = False

CmdПуск.SetFocus

End If

End Sub

Private Sub txta_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

On Error GoTo L

LblСообщ.ForeColor = RGB(0, 0, 0)

LblСообщ.Caption = _

"Закончив ввод, нажмите клавишу Enter!"

LblСообщ.Visible = True

Txta.ForeColor = RGB(0, 0, 0)

Select Case KeyAscii

Case 0, 8, 44, 45, 48 To 57, 101

Case Else

KeyAscii = 0

End Select

Exit Sub

LblСообщ.ForeColor = RGB(255, 0, 0)

LblСообщ.Caption = _

"Это не число! Исправьте!"

L: LblСообщ.Visible = True

Txta.ForeColor = RGB(255, 0, 0)

End Sub

Private Sub txtb_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

On Error GoTo L

LblСообщ.ForeColor = RGB(0, 0, 0)

LblСообщ.Caption = _

"Закончив ввод, нажмите клавишу Enter!"

LblСообщ.Visible = True

Txtb.ForeColor = RGB(0, 0, 0)

Select Case KeyAscii

Case 0, 8, 44, 45, 48 To 57, 101

Case Else

KeyAscii = 0

End Select

Exit Sub

L: LblСообщ.ForeColor = RGB(255, 0, 0)

LblСообщ.Caption = _

"Это не число! Исправьте!"

LblСообщ.Visible = True

Txtb.ForeColor = RGB(255, 0, 0)

End Sub

Private Sub txteps_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

On Error GoTo L

LblСообщ.ForeColor = RGB(0, 0, 0)

LblСообщ.Caption = _

"Закончив ввод, нажмите клавишу Enter!"

LblСообщ.Visible = True

Txteps.ForeColor = RGB(0, 0, 0)

Select Case KeyAscii

Case 0, 8, 44, 45, 48 To 57, 101

Case Else

KeyAscii = 0

End Select

Exit Sub

L: LblСообщ.ForeColor = RGB(255, 0, 0)

LblСообщ.Caption = _

"Это не число! Исправьте!"

LblСообщ.Visible = True

Txteps.ForeColor = RGB(255, 0, 0)

End Sub

Функция вычисления значений функции f(x)=0.

Private Function f(x As Single) As Single

f = 3 * x - 4 * Log(x) - 5

End Function

Private Function p1(x As Single) As Single

p1 = 3 - 4 / x

End Function

Private Sub koren(pred As Integer, a As Single, b As Single, eps As Single, xw As Single, it As Integer, Flag As Boolean)

Dim xn As Single, xs As Single

Dim fxn As Single, fxs As Single

Dim p1xn As Single

Dim Bool As Boolean

xn = (a + b) / 2

it = 0

Do

p1xn = p1(xn)

fxn = f(xn) ' вызов функции f для расчета ее значения в точке xn

xs = xn - fxn / p1xn ' вычисление xs

fxs = f(xs)

it = it + 1

Bool = Abs(xs - xn) < eps Or it > pred

xn = xs

Loop Until Bool 'если |xs-xn|< или превышено количество итераций, то цикл заканчивается

If it <= pred Then

Flag = False

xw = xs

Else

Flag = True

End If

End Sub

Процедура вывода расчетов в книгу Excelle и построения графика.

Private Sub График()

Dim x As Single, h As Single

Dim n As Integer

h = 0.1

n = 2

Worksheets("Лист1").Range("A1").Value = "x"

Worksheets("Лист1").Range("B1").Value = "y"

For x = a To b + h / 2 Step h

Worksheets("Лист1").Range("A" & n) = x

Worksheets("Лист1").Range("B" & n) = f(x)

n = n + 1

Next

ActiveWorkbook.Charts.Add Worksheets("Лист2")

Charts(1).ChartWizard Worksheets("Лист1").Range("A2:B" & (n - 1)), xlLine, , , 1, , , "график функции", "x", "F(x)"

End Sub

Private Sub cmdПуск_Click()

Dim xw As Single, it As Single

Dim Flag As Boolean

'сделаем недоступным изменение полей и надписей в форме

LblСообщ.Visible = False

LblЗначКоР.Visible = False

LblРезультат.Visible = False

LblКолИт.Visible = False

Lblвып.Visible = False

LblИт.Visible = False

'Проверка задания значений исходных данных

If Not Задано_a Then

LblСообщ.ForeColor = RGB(255, 0, 0)

LblСообщ.Caption = "Не задан левый конец отрезка"

LblСообщ.Visible = True

Txta.SetFocus

Exit Sub

End If

If Not Задано_b Then

LblСообщ.ForeColor = RGB(255, 0, 0)

LblСообщ.Caption = "Не задан правый конец отрезка"

LblСообщ.Visible = True

Exit Sub

End If

If Not Задано_eps Then

LblСообщ.ForeColor = RGB(255, 0, 0)

LblСообщ.Caption = "Не задана допустимая ошибка"

LblСообщ.Visible = True

Exit Sub

End If

a = Txta.Text

b = Txtb.Text

eps = Txteps.Text

' Проверка корректности данных

If a >= b Then

LblСообщ.ForeColor = RGB(255, 0, 0)

LblСообщ.Caption = "Нарушено условие a < b?"

LblСообщ.Visible = True

Exit Sub

End If

If eps <= 0 Then

LblСообщ.ForeColor = RGB(255, 0, 0)

LblСообщ.Caption = "Допустимая ошибка eps не может быть < 0 "

LblСообщ.Visible = True

Exit Sub

End If

' Вычисление корня

it = 0

koren 100, a, b, eps, xw, it, Flag

' Вывод результатов вычислений

If Flag Then

LblСообщ.ForeColor = RGB(255, 0, 0)

LblСообщ.Caption = "Решение не получено!"

LblСообщ.Visible = True

Exit Sub

Else

LblСообщ.ForeColor = RGB(0, 0, 255)

LblСообщ.Font.Size = 12

LblСообщ.Caption = "Решение получено!"

LblСообщ.Visible = True

LblЗначКоР.Visible = True

LblРезультат.Caption = xw

LblРезультат.Visible = True

LblКолИт.Caption = it

LblКолИт.Visible = True

Lblвып.Visible = True

LblИт.Visible = True

End If

' вывод данных в книгу Excel

График

End Sub

Блок схема