Программа табулирование разветвляющейся функции вVва
Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Integer
Dim x As Single
Dim xn As Single
Dim xk As Single
Dim dx As Single
Dim g As Single
xn = InputBox("Xn = ", "Ввод начального значения x", -3, 8000, 2000)
xk = InputBox("Xk = ", "Ввод конечного значения x", 7, 8000, 1000)
dx = InputBox("dX = ", "Ввод значения шага x", 0.5, 8000, 2000)
i = InputBox("i = ", "Ввод значения начала таблицы, строка i", 5, 8000, 1000)
j = InputBox("j = ", "Ввод значения начала таблицы, столбец j", 5, 8000, 2000)
x = xn: Cells(i, j) = "X(vba)": Cells(i, j + 1) = "G1(vba)": Cells(i, j + 2) = "G2(vba)"
10 Cells(i + 1, j) = x
If x <= 0 Then
g = Sin(x)
Cells(i + 1, j + 1) = g
Else
g = Exp(-x)
Cells(i + 1, j + 2) = g
End If
x = x + dx
i = i + 1
If x > xk Then GoTo 20 Else GoTo 10
20 End Sub
– Применен условный оператор, у которого в частях Then и Else находятся по два оператора, поэтому по грамматическим требованиям необходим переход на другую строку и завершается оператор End If.
Программа табулирования в VВА
Функции, разветвляющейся больше, чем один раз
Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Integer
Dim x As Single
Dim xn As Single
Dim xk As Single
Dim dx As Single
xn = InputBox("Xn = ", "Ввод начального значения x", -3, 8000, 2000)
xk = InputBox("Xk = ", "Ввод конечного значения x", 7, 8000, 1000)
dx = InputBox("dX = ", "Ввод значения шага x", 0.5, 8000, 2000)
i = InputBox("i = ", "Ввод значения начала таблицы, строка i", 5, 8000, 1000)
j = InputBox("j = ", "Ввод значения начала таблицы, столбец j", 6, 8000, 2000)
x = xn: Cells(i, j) = "X(vba)": Cells(i, j + 1) = "Z1(vba)": Cells(i, j + 2) = "Z2(vba)": Cells(i, j + 3) = "Z3(vba)"
10 Cells(i + 1, j) = x
If x <= 0 Then
z = Sin(x)
Cells(i + 1, j + 1) = z
End If
If (x > 0) And (x <= 3.5) Then
z = Exp(-x)
Cells(i + 1, j + 2) = z
End If
If x > 3.5 Then
z = Application.Ln(x)
Cells(i + 1, j + 3) = z
End If
x = x + dx
i = i + 1
If x > xk Then GoTo 20 Else GoTo 10
20 End Sub
Некоторые комментарии к программе:
– Применены три неполных условных оператора, по количеству условий задания. Так как у каждого оператора в частях Then находятся по два оператора, то по грамматическим требованиям необходим переход на другую строку и завершается каждый оператор End If;
– Можно было воспользоваться вложенными условными операторами, но очень часто возникают логические ошибки при оценке уровня вложенности после части ELSE. Считается целесообразным при решении подобных задач использование грамматической конструкции, в которой количество неполных условных операторов соответствует числу логических условий решаемой задачи;
– В программе используется сложное логическое выражение
(x > 0) And (x <= 3.5),
состоящее из двух простых, объединенных логической функцией And.
Программа табулирования двух функций вVва
Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Integer
Dim x As Single
Dim xn As Single
Dim xk As Single
Dim dx As Single
e = 0.001
xn = InputBox("Xn = ", "Ввод начального значения x", -1, 8000, 2000)
xk = InputBox("Xk = ", "Ввод конечного значения x", 0.3, 8000, 1000)
dx = InputBox("dX = ", "Ввод значения шага x", 0.05, 8000, 2000)
i = InputBox("i = ", "Ввод значения начала таблицы, строка i", 5, 8000, 1000)
j = InputBox("j = ", "Ввод значения начала таблицы, столбец j", 4, 8000, 2000)
x = xn: Cells(i, j) = "X(vba)": Cells(i, j + 1) = "V(vba)": Cells(i, j + 2) = "W(vba)"
10 Cells(i + 1, j) = x
v = Sin(x ^ 2) + Cos(Application.WorksheetFunction.Pi * x) ^ 3
Cells(i + 1, j + 1) = v
w = Cos(x ^ 3) ^ 2 - Sin(Application.WorksheetFunction.Pi * x ^ 2)
Cells(i + 1, j + 2) = w
x = x + dx
i = i + 1
If x <= xk + e Then GoTo 10
End Sub
Некоторые комментарии к программе:
– В программе в логическом выражении x <= xk + e используется цифровая константа e = 0.001, применение которой обеспечивает получение спектра значений X от -1 до 0.3 включительно;
– В тексте программы встречаются обращения к Приложению, например, Cos(Application.WorksheetFunction.Pi), которое означает, что, чтобы вызвать функцию p последовательно обращаются сначала к приложению Application, затем к функциям рабочего листа WorksheetFunction и, наконец, к конкретной функции Pi;
– Чтобы не допустить ошибки в этой, достаточно сложной, грамматической конструкции, следует воспользоваться возможностями дружественного интерфейса VBA, для чего в тексте программы написать Cos(Application и после постановки точки появится подменю разделов Приложения, рис. 4.2;
Рис. 4.2
После точки следует добавить букву W и тогда в подменю появится раздел WorksheetFunction, рис. 4.3.
Рис. 4.3.
Выбрать раздел WorksheetFunction, после чего поставить точку и в появившемся подменю списка функций рабочего листа, выбрать функцию Pi, рис. 4.4.
Рис. 4.4.
Продолжить запись арифметического выражения Cos(Application.WorksheetFunction.Pi в соответсвии с выполняемым заданием.
Private Sub CommandButton1_Click()
Dim L,A,X As Integer
‘Cells(1,1)=Clear
Range(Columns(1),Rows(15))=Clear
D=InputBox(“D=”,”Введите диапазон игры”)
Cells(1,3)=”Ну что ж играем, угадай число X в диапазоне от 0 до”+CStr(d)
Randomize
X=Round(d*Rnd())
‘Cells(1,3)=X
L=0:i=10:j=1
10 A=InputBox(“x=”,Введите Ваш вариант”)
L=L+1”i=i+1
If X >A Then
Cells(I,j)=”Загаданное число X больше Вашего числа”+CStr(A)
Go To 10
End If
If X <A Then
Cells(i,j)=”Загаданное число Х меньше Вашего числа”+CStr(A)
Go To 10
End If
If X=A Then
Cells(I,j)=”Да, это число”+CStr(A)+”,Угадал,за”+CStr(L)+"пыток”
Cells(1,1).Select
Exit Sub
End If
End Sub
Private Sub CommandButton2_Click()
Dim i As Integer
Dim il As Integer
Dim j As Inteder
Dim j As Integer
Dim x, y, x0, xk, dx As Double
X0=InputBox(“x0=”,”Введите начальное значение диапазона x”, -2)
Xk=InputBox(“xk=”,”Введите конечное значение диапазона x”,2)
Dx=InputBox(“dx=”,”Введите шаг изменения переменной x”,0.5)
I=InputBox(“i=”,”Введите начало таблицы, строкуЭб1)
J=InputBox(“j=”,”Введите начало таблицы, столбец”,1)
Cells(i,j)=”X”
I1=i
Cells(I,j+1)=”Y”
I=i+1
X=x0
Do While x <=xk
Y=ff(x)
Cells(I,j)=Format(x,”0.0#”)
Cells (I,j+1)=Format(y,”#0.0##”)
X=x+dx:i=i+1
Loop
Range(Cells(i1,j),Cells(i-1,j+1)).Select
Selection.Font.Size=16
With Selection
.Font.Bold=True
.Interior.Pattern=x1Solid
‘VerticalAligment=xlBotton
‘.WrapText=False
‘.Orientation=0
‘.AddIndent=False
‘ShrinkToFit=False
‘.MergeCells=False
End With
End Sub