Лабораторная работа №2
Тема: Работа с управляющими структурами VBA
Вариант №1
Задача: Разработать программу на VBA, которая в ответ на вводимую с клавиатуры пару вещественных чисел, представляющих собой координаты Х и Y, точки А на плоскости, выдает текстовое сообщение о принадлежности этой точки заданной области. Например, «Точка принадлежит закрашенной области». В программе должно быть предусмотрено неограниченное повторение всех операций. Решение о повторе должен принимать пользователь с помощью клавиатуры.
Графическая схема и пояснения:
Первая закрашенная область задается системой неравенств:
Первое неравенство задает точки внутри круга, второе неравенство задает точки внутри эллипса, третье – точки под прямой. При пересечении эти области дадут нам первую закрашенную область.
Вторая закрашенная область задается системой неравенств:
начало
x,y
(((sqr(x+25)+sqr(y-25)<=625)
and
(sqr(x)/6400+sqr(y-50)/2025<=1)
and
(y<=sin(5/6*pi)/cos(5/6*pi)*(x-40)))or
((sqr(x)/6400+sqr(y-50)/2025<=1)
and
(y>=sin(5/6*pi)/cos(5/6*pi)*(x-40))
and
(x>=0)))
'Точка
А не принадлежит закрашенной области
'Точка
А
принадлежит
закрашенной
области
конец
Текст программы:
Const pi = 3.14159265358979
Dim x, y As Double
Sub Vichislenie()
Dim t As String
1: t = InputBox("Введите значение x:")
x = Val(t)
t = InputBox("Введите значение y:")
y = Val(t)
If ((((x + 25) ^ 2 + (y - 25) ^ 2 <= 625) And (x ^ 2 / 6400 + (y - 50) ^ 2 / 2025 <= 1) And (y <= Sin(5 / 6 * pi) / Cos(5 / 6 * pi) * (x - 40))) Or ((x ^ 2 / 6400 + (y - 50) ^ 2 / 2025 <= 1) And (y >= Sin(5 / 6 * pi) / Cos(5 / 6 * pi) * (x - 40)) And (x >= 0))) Then MsgBox ("Точка А принадлежит закрашенной области") Else MsgBox ("Точка А не принадлежит закрашенной области")
ret = MsgBox("Повторить вычисления?", vbYesNo, " ")
If ret = vbYes Then
GoTo 1
End If
End Sub
Тесты:
1) Введите координаты точки А:
x=-25
y=25
Точка А принадлежит закрашенной области.
2) Введите координаты точки а:
x=-25
y=50
Точка А не принадлежит закрашенной области.
3) Введите координаты точки а:
x=40
y=20
Точка А принадлежит закрашенной области.
4) Введите координаты точки а:
x=40
y=1
Точка А не принадлежит закрашенной области.
Лабораторная работа №3
Тема: Операторы повторения (циклы). Итерационные методы вычислений.
Вариант №1
Задача: Разработать программу на VBA вычисления заданной площади, используя три различных метода вычислений: прямоугольников, трапеции и Симпсона. Результат вывести в таблицы EXCEL.
Число разбиений |
Результат |
||
N |
A |
B |
C |
N1 |
A1 |
B1 |
C1 |
N2 |
A2 |
B2 |
C2 |
N3 |
A3 |
B3 |
C3 |
Пояснения: Для решения реализации данной задачи были разработаны следующие процедуры и функции: Расчет(), F(x), Sbar(n), Strap(n), SSim(n), S_figyri, Очистка().
Главной среди данных процедур является процедура Расчет. В этой процедуре с помощью команды InputBox происходит ввод значений переменных a и b, а – это начало отрезка интегрирования (суммирования площадей), b - это конец отрезка интегрирования. Так как в методическом пособии не была указана функция, образующая фигуру, то мы сами выбрали эту функцию и интервалы интегрирования. После введения интервала интегрирования мы, используя цикл с параметром, вводим количество разбиений интервала интегрирования. По заданию их 3. Их значения сохраняем в одномерном массиве N().Так как вводимые значения воспринимаются средой VBA как строки, то используя функцию Val, преобразуем введенные значения в числовые.
Далее, используя цикл с параметром i от 1 до 3 и вложенный в него цикл по j от 1 до 3 заполняем двумерный массив S() 3 на 3 значениями площади заданной фигуры, рассчитанной тремя различными методами и с различными вариантами разбиения интервала интегрирования. Методы вычисления площадей записаны в отдельных функциях, описанных ниже, а количество разбиений берем из заполненного ранее массива N.
Далее идет обращение к процедуре S_figyri. Эта процедура изначально создана с помощью записи макроса, ее цель – оформление таблицы на листе Excel заданным образом. Затем мы зашли в VBA и отредактировали макрос так, чтобы он еще и заполнял таблицу полученными значениями площадей.
Далее, используя процедуру вывода MsgBox и константу vbYesNo, мы выводим на экран окно с вопросом о повторе вычислений. Если пользователь нажмет YES, то произойдет сначала очистка ячеек таблицы с помощью процедуры Очистка (записана как макрос), а затем переход к метке 1 и начнется повтор ввода данных и вычисления. Если пользователь выберет No, то произойдет завершение работы программы.
В программе каждый метод отыскания площади записан как отдельная функция. Ниже приведены блок-схемы для каждого метода.
Справочный материал
1. Формулы прямоугольников: h[Y(0)+Y(1)+ ... +Y(N-1)]
2. Формула трапеций: h[(Y(0)+Y(N))/2+Y(1)+Y(2)+ ... +Y(N-1)]
3. Формула Симпсона: h/6[(Y(0)+Y(N)+2(Y(1)+Y(2)+ ... +Y(N-1))+
+4(Y(1/2)+Y(3/2)+ ... +Y(N-1/2))]
Здесь: h - шаг дискретизации (h=(B-A)/N) на отрезке интегрирования [A,B]; N - число разбиений; Y(i) - значение подинтегральной функции на i-том шаге дискретизации, Y(0) и Y(N) - соответственно значения функции в начальной и конечной точках отрезка интегрирования, Y(1/2), Y(3/2), Y(N-1/2) - значения функции в точках середин отрезков соответственно между 1-м и 2-м, 2-м и 3-м, (N-1)-м и N-м итерациями или шагами.
Так как в задании не указана функция, по которой нужно находить площадь, то мы взяли для примера элементарную F = x ^ 5, которую можно заменить, сделав исправления в функции
Function F(x) As Double
F = x ^ 5
End Function
Для удобства запуска программы на листе Excel создана кнопка, с которой связан макрос запуска процедуры Расчет:
Sub лаб3_Прямоугольник1_Щелчок()
Call Rachet
End Subb
Текст программы:
Dim a, b, x As Double
Dim s(1 To 3, 1 To 3) As Double
Dim n(1 To 3) As Double
Sub Rachet()
Dim text As String
Dim i, j As Byte
1: text = InputBox("Введите значение А:")
a = Val(text)
text = InputBox("Введите значение B:")
b = Val(text)
For i = 1 To 3
text = InputBox("Введите значение n" & i)
n(i) = Val(text)
Next i
For i = 1 To 3
For j = 1 To 3
If j = 1 Then s(i, j) = SBar(n(i)) Else
If j = 2 Then s(i, j) = STrap(n(i)) Else s(i, j) = SSim(n(i))
Next j
Next i
Call S_figyri
Dim ret As Integer
ret = MsgBox("Повторить вычисления?", vbYesNo, " ")
If ret = vbYes Then
Call Очистка
GoTo 1
End If
End Sub
Function F(x) As Double
F = x ^ 5
End Function
Function SBar(n) As Double
Dim h As Double
h = Abs(b - a) / n
x = a
SBar = 0
For i = 1 To n Step 1
SBar = SBar + F(x + h / 2) * h
x = x + h
Next i
End Function
Function STrap(n)
Dim h, sa, sb As Double
h = Abs(b - a) / n
x = a
STrap = 0
For i = 1 To n Step 1
sa = F(x)
sb = F(x + h)
STrap = STrap + (sa + sb) / 2 * h
x = x + h
Next i
End Function
Function SSim(n)
Dim h, sa, sb As Double
h = Abs(b - a) / n
x = a
SSim = 0
For i = 1 To n Step 1
sa = F(x)
sb = F(x + h)
SSim = SSim + (2 * sa + sb) * h / 3
x = x + h
Next i
End Function
Sub S_figyri()
'
' S_figyri Макрос
'
' Сочетание клавиш: Ctrl+s
'
Range("A1").Select
ActiveCell.FormulaR1C1 = "Число разбиений"
Range("A2").Select
ActiveCell.FormulaR1C1 = "N"
Range("A3").Select
ActiveCell.FormulaR1C1 = "n1"
Range("A4").Select
ActiveCell.FormulaR1C1 = "n2"
Range("A5").Select
ActiveCell.FormulaR1C1 = "n3"
Range("A3").Select
ActiveCell.FormulaR1C1 = Str(n(1))
Range("A4").Select
ActiveCell.FormulaR1C1 = Str(n(2))
Range("A5").Select
ActiveCell.FormulaR1C1 = Str(n(3))
Range("A6").Select
Range("B3").Select
ActiveCell.FormulaR1C1 = Str(s(1, 1))
Range("C3").Select
ActiveCell.FormulaR1C1 = Str(s(1, 2))
Range("d3").Select
ActiveCell.FormulaR1C1 = Str(s(1, 3))
Range("B4").Select
ActiveCell.FormulaR1C1 = Str(s(2, 1))
Range("C4").Select
ActiveCell.FormulaR1C1 = Str(s(2, 2))
Range("d4").Select
ActiveCell.FormulaR1C1 = Str(s(2, 3))
Range("B5").Select
ActiveCell.FormulaR1C1 = Str(s(3, 1))
Range("C5").Select
ActiveCell.FormulaR1C1 = Str(s(3, 2))
Range("d5").Select
ActiveCell.FormulaR1C1 = Str(s(3, 3))
Columns("A:A").ColumnWidth = 16.14
Range("A1:A5").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B1:D1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = ""
Range("B15").Select
ActiveCell.FormulaR1C1 = ""
Range("B1:D1").Select
ActiveCell.FormulaR1C1 = "Результат"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Метод прямоугольников"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Метод трапеции"
Range("D2").Select
ActiveCell.FormulaR1C1 = "Метод Симпсона"
Cells.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("D6").Select
Columns("B:B").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 11.57
Columns("C:C").ColumnWidth = 10.86
Columns("D:D").ColumnWidth = 11.14
Range("A1:D5").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Sub Очистка()
'
' Очистка Макрос
' Очищает ячейки с вычислениями
'
' Сочетание клавиш: Ctrl+o
'
Range("a3:D5").Select
Selection.ClearContents
End Sub
Тесты: y=x^5, a=0, b=1
