Пример программного модуля для решения корней квадратного уравнения

Пример программного модуля для решения «Контрольная работа №2»

Function yy(x As Double) As Double

If (x = 0) Then yy = Sin(1) Else yy = Sin(Application.Ln(1 + x) / x) * Exp(x)

End Function

Sub Pabota1()

Dim x As Double

Dim y As Double, i As Double, h As Double

Worksheets(1).Activate

Do

Do

prom = InputBox("Введите начальную границу отрезка a=")

If Not IsNumeric(prom) Then MsgBox ("Повторите ввод")

Loop Until IsNumeric(prom)

a = prom

Do

prom = InputBox("Введите конечную границу отрезка b=")

If Not IsNumeric(prom) Then MsgBox ("Повторите ввод")

Loop Until IsNumeric(prom)

b = prom

If a >= b Then MsgBox ("Повторите ввод")

Loop Until a < b

Do

prom = InputBox("Количество шагов табулирования n=")

If Not IsNumeric(prom) Then MsgBox ("Повторите ввод")

Loop Until IsNumeric(prom)

n = prom

Worksheets("Лист1").Activate

Cells.Clear

Range("d1") = "Контрольная работа №2"

Range("c2") = "Табулирование функции y=Sin(ln(1+x)/x)*Exp(x)"

Range("e3") = "Исходные данные"

Range("d4") = "Начальная граница функции a=" & CSng(a)

Range("d5") = "Конечная граница функции b=" & CSng(b)

Range("d6") = "Количество шагов табулирования n=" & CByte(n)

h = (b - a) / n

Range("d7") = "Шаг табулирования h=" & CSng(h)

Range("b8") = "Результаты вычислений"

Range("b9") = "№ п/п"

Range("c9") = "x"

Range("d9") = "y"

Range("e9") = "Экстремумы"

x = a

For i = 1 To n + 1

x = a + (i - 1) * h

Range(Cells(9 + i, 2), Cells(9 + i, 2)) = CSng(i)

Range(Cells(9 + i, 3), Cells(9 + i, 3)) = CSng(x)

If x <= -1 Then Range(Cells(9 + i, 4), Cells(9 + i, 4)) = "Не существует"

If x <> -1 Then Range(Cells(9 + i, 4), Cells(9 + i, 4)) = CSng(yy(x))

Next i

For i = 1 To n + 1

If Cells(9 + i, 4).Value = Application.Max(Range("d10:D30").Value) Then Range(Cells(9 + i, 5), Cells(9 + i, 5)) = "Максимум"

If Cells(9 + i, 4).Value = Application.Min(Range("d10:D30").Value) Then Range(Cells(9 + i, 5), Cells(9 + i, 5)) = "Минимум"

Next i

End Sub

Пример программного модуля для решения задания «График №1»

Function yy(x As Double) As Double

a = 1

b = 1

c = 2

d = 3

If (x < 0) Then yy = (a + x ^ 2 / (b + x ^ 2))

If (x >= 0) And (x <= 1) Then yy = c * (Cos(x)) ^ 2 * Exp(-x)

If (x > 1) Then yy = (1 + Abs(2 * Sin(d * x)) ^ (1 / 3)) ^ (1 / 2)

End Function

Sub Pabota1()

Dim x As Double

Dim y As Double, i As Double, h As Double

Worksheets(1).Activate

Do

Do

prom = InputBox("Введите начальную границу отрезка a1 = ")

If Not IsNumeric(prom) Then MsgBox ("Повторите ввод")

Loop Until IsNumeric(prom)

a1 = prom

Do

prom = InputBox("Введите конечную границу отрезка b1 = ")

If Not IsNumeric(prom) Then MsgBox ("Повторите ввод")

Loop Until IsNumeric(prom)

b1 = prom

If a1 >= b1 Then MsgBox ("Повторите ввод")

Loop Until a1 < b1

Do

prom = InputBox("Количество шагов табулирования n=")

If Not IsNumeric(prom) Then MsgBox ("Повторите ввод")

Loop Until IsNumeric(prom)

n = prom

Worksheets("Лист1").Activate

Cells.Clear

Range("d1") = "График 1"

Range("c2") = "Табулирование функции y = f(x) "

Range("e3") = "Исходные данные"

Range("d4") = "Начальная граница функции a1= " & CSng(a1)

Range("d5") = "Конечная граница функции b1= " & CSng(b1)

Range("d6") = "Количество шагов табулирования n= " & CByte(n)

h = (b1 - a1) / n

Range("d7") = "Шаг табулирования h=" & CSng(h)

Range("b8") = "Результаты вычислений"

Range("b9") = "№ п/п"

Range("c9") = "x"

Range("d9") = "y"

Range("e9") = "Экстремумы"

x = a1

For i = 1 To n + 1

x = a1 + (i - 1) * h

Range(Cells(9 + i, 2), Cells(9 + i, 2)) = CSng(i)

Range(Cells(9 + i, 3), Cells(9 + i, 3)) = CSng(x)

Range(Cells(9 + i, 4), Cells(9 + i, 4)) = CSng(yy(x))

Next i

For i = 1 To n + 1

If Cells(9 + i, 4).Value = Application.Max(Range("d10:D30").Value) Then Range(Cells(9 + i, 5), Cells(9 + i, 5)) = "Максимум"

If Cells(9 + i, 4).Value = Application.Min(Range("d10:D30").Value) Then Range(Cells(9 + i, 5), Cells(9 + i, 5)) = "Минимум"

Next i

End Sub

Пример программного модуля для решения задачи «Треугольник»

Sub Pabota2()

Worksheets(2).Activate

Dim a As Double, b As Double, c As Double, p As Double, s As Double

a = InputBox("Введите a=")

b = InputBox("Введите b=")

c = InputBox("Введите c=")

Worksheets("Лист2").Activate

Cells.Clear

Range("a1") = "Стороны треугольника"

Range("a2") = " a="

Range("a3") = " b ="

Range("a4") = " c ="

Range("a6") = " p ="

p = (a + b + c) / 2

s = (p * (p - a) * (p - b) * (p - c)) ^ (1 / 2)

r = s / p

r1 = a * b * c / (4 * s)

Range("a8") = " s ="

Range("d10") = " r ="

Range("f10") = " R ="

Range("b2") = CSng(a)

Range("b3") = CSng(b)

Range("b4") = CSng(c)

Range("b6") = CSng(p)

Range("b8") = CSng(s)

Range("e10") = CSng(r)

Range("g10") = CSng(r1)

Пример программного модуля для решения корней квадратного уравнения

 

Sub Pabota2()

Dim y As Double, i As Double, h As Double

Worksheets(1).Activate

prom = InputBox("Введите a=")

a = prom

prom = InputBox("Введите b=")

b = prom

prom = InputBox("Введите c=")

c = prom

Worksheets("Лист1").Activate

Cells.Clear

Range("d1") = "Вычисление корней квадратного уравненения"

Range("e3") = "Исходные данные"

Range("d4") = " a = " & CSng(a)

Range("d5") = " b = " & CSng(b)

Range("d6") = " c = " & CSng(c)

Range("b8") = "Результаты вычислений"

Range("a9") = "A"

Range("b9") = "B"

Range("c9") = "C"

Range("d9") = "Дискриминант"

d = (b * b - 4 * a * c)

Range("e9") = "X1"

Range("f9") = "X2"

Range("a10") = CSng(a)

Range("b10") = CSng(b)

Range("c10") = CSng(c)

Range("d10") = CSng(d)

If (d < 0) Then Range("d10") = "Нет решения"

If (d = 0) Then x1 = -b / (2 * a)

If (d > 0) Then x1 = (-b - (d) ^ (1 / 2)) / (2 * a)

If (d > 0) Then x2 = (-b + (d) ^ (1 / 2)) / (2 * a)

Range("e10") = CSng(x1)

Range("f10") = CSng(x2)

End Sub