Тема: Программирование на VBA
Цель работы: научиться реализовывать алгоритмы в среде VBA
Ход работы:
Задание I
1) Нахождение минимального числа из четырех заданных чисел A, B, C, D. Выполнение работы изображено на рисунке 1.
Рисунок 1 – Нахождение минимального числа
Листинг программы:
Public Function Min(a, b, c, d)
If a < b Then
m = a
Else
m = b
End If
If c < d Then
n = c
Else
n = d
End If
If m < n Then
Min = m
Else
Min = n
End If
End Function
2) Решение линейного уравнения вида аx=c, где a и c - заданные коэффициенты, в том числе и нулевые (рисунок 2).
Рисунок 2 – Решение линейного уравнения
Листинг программы:
Public Function lin(a, c)
If a = 0 Then
lin = 0
Else: d = c \ a
lin = d
End If
End Function
3) Определение вида треугольника (равносторонний, равнобедренный, прямоугольный), если три заданных числа a, b, c задают длины его сторон (рисунок 3).
Рисунок 3 – Определение вида треугольника
Листинг программы:
Public Function Treygol(a, b, c)
If (a = c And c <> b) Or (a = b And b <> c) Then
Treygol = " Равнобедренный "
Else
End If
If a = b And b = c Then
Treygol = " Равносторонний "
Else
End If
If (a ^ 2 = c ^ 2 + b ^ 2) Or (c ^ 2 = a ^ 2 + b ^ 2) Or (b ^ 2 = a ^ 2 + c ^ 2) Then
Treygol = " Прямоугольный "
End If
End Function
4) Нахождение площади треугольника, если три заданных числа a, b, c задают длины его сторон (рисунок 4).
Рисунок 4 – Нахождение площади треугольника
Листинг программы:
Public Function Plos(a, b, c)
pl = a + b + c
Plos = (pl * (pl - a) * (pl - b) * (pl - c)) \2
End Function
5) Найти площадь трапеции, если четыре заданных числа задают длины ее сторон (рисунок 5).
Рисунок 5 – Нахождение площади трапеции
Листинг программы:
Public Function Trap(a, b, c, d)
pl = a + c + (d - b)
h = (2 * (pl * (pl - a) * (pl - (d - b)) * (pl - c)) ^ 0.5) \ (d - b)
t = (h * (d - b)) \ 2
pl = h * b
Trap = t + pl
End Function
Задание II
На VBA составить функции для:
1) Найти , где n заданное число. Выполнение работы изображено на рисунке 6.
Рисунок 6 – Выполнение заданной функции
Листинг программы:
Public Function sum(n)
sum = 0
For i = 1 To n
sum = sum + (1 / i)
Next i
End Function
2) Найти , где m и n заданные числа (рисунок 7).
Рисунок 7 – Выполнение заданной функции
Листинг программы:
Public Function sum2(n, m)
sum2 = 0
For i = m To n
sum2 = sum2 + (2 * i)
Next i
End Function
3) Вычисление суммы S=103+113+…+n3 (рисунок 8).
Рисунок 8 – Вычисление суммы
Листинг программы:
Public Function sum3(n)
If n > 11 Then
sum3 = 0
For i = 10 To n
sum3 = sum3 + (i ^ 3)
Next i
Else
sum3 = "Неверно введено"
End If
End Function
4) Вычислить сумму кубов трехзначных четных чисел (рисунок 9).
Рисунок 9 – Вычисление суммы
Листинг программы:
Public Function sum4(n, m)
If ((99 > n < 1000) And (n Mod 2 = 0)) And ((99 > m < 1000) And (m Mod 2 = 0)) Then
sum4 = n ^ 3 + m ^ 3
Else
sum4 = "Неверно введено"
End If
End Function
5) Вычислить сумму квадратов тех четырехзначных чисел, которые при делении на 5 дают в остатке 2 (рисунок 10).
Рисунок 10 – Вычисление суммы квадратов
Листинг программы:
Public Function summ5(n, m)
If ((999 > n < 10000) And (n Mod 5 = 2)) And ((999 > m < 10000) And (m Mod 5 = 2)) Then
summ5 = n ^ 2 + m ^ 2
Else
summ5 = " неверный ввод"
End If
End Function
6) Найти сумму всех несократимых дробей, со знаменателем к, содержащихся между целыми числами m и n, где к простое число (рисунок 11).
Рисунок 11 – Вычисление суммы несократимых дробей
Листинг программы:
Public Function sum6(m, n, k)
suma6 = 0
For i = m To n
If (i Mod k <> 0) Then
suma6 = suma6 + (i / k)
Else
sum6 = "n"
End If
Next i
sum6 = suma6
End Function
7) Найти сумму S=1*100+2*99+3*98+…+ 50 *51 (рисунок 12).
Рисунок 12 – Вычисление суммы несократимых дробей
Листинг программы:
Public Function sum7()
p = 0
m = 100
For i = 1 To 50
p = p + (m * i)
m = m - 1
Next i
sum7 = p
End Function
8) Вычисление произведения P=n!=1*2*….*n (рисунок 13).
Рисунок 13 – Вычисление произведения
Листинг программы:
Public Function proizved(n)
p = 1
For i = 1 To n
p = p * i
Next i
proizved = p
End Function
9) Нахождение такой суммы S=1+2+3+…, для которой |S-M| минимально. M –заданное число (рисунок 14).
Рисунок 14 – Вычисление произведения
Листинг программы:
Public Function suma9(n, m)
k = 0
p = 0
For i = 1 To n
p = p + i
Next i
k = p - m
suma9 = k
End Function
10) Вычисление суммы S= 1!+2!+3!+……+ n! (рисунок 15).
Рисунок 15 – Вычисление суммы
Листинг программы:
Public Function summ9(n)
k = 0
p = 1
For i = 1 To n
p = 1
For j = 1 To i
p = p * j
Next j
k = k + p
Next i
summ9 = k
End Function
Задание III
На VBA составить функции, позволяющие:
1) Сформировать строку длины N (N — четное), которая состоит из чередующихся символов C1 и C2, начиная с C1. Выполнение задания приведено ни рисунке 16.
Рисунок 16 – Формирование строки
Листинг программы:
Public Function str1(C1, C2, N) As String
For i = 1 To N
str1 = str1 + (C1 + C2)
Next i
End Function
2) Дана строка. Получить строку, содержащую те же символы, но расположенные в обратном порядке (рисунок 17).
Рисунок 17 – Получение обратной строки
Листинг программы:
Public Function str2(C1) As String
str2 = StrReverse(C1)
End Function
3) Дана строка S и число N. Преобразовать строку S в строку длины N следующим образом: если длина строки S больше N, то отбросить первые символы, если длина строки S меньше N, то в ее начало добавить символы "." (точка). Выполнение задания изображено на рисунке 18.
Рисунок 18 – Преобразование строки
Листинг программы:
Public Function str3(S, N) As String
If (Len(S) > N) Then
str3 = Right(S, N)
Else
End If
If (Len(S) < N) Then
str3 = String(N - Len(S), ".") + S
End If
End Function
4) Даны два числа: N1 и N2, и две строки: S1 и S2. Получить из этих строк новую строку, объединив N1 первых символов строки S1 и N2 последних символов строки S2 (рисунок 19).
Рисунок 19 – Получение строки
Листинг программы:
Public Function str4(S1, S2 As String, N, M) As String
str4 = Left(S1, N) + Right(S2, M)
End Function
5) Даны две строки: S1 и S2. Проверить, содержится ли строка S2 в строке S1. Если да, то вывести номер позиции, начиная с которой S2 содержится в S1, если нет, то вывести 0 (рисунок 20).
Рисунок 20 – Вывод номера позиции
Листинг программы:
Public Function str5(S1, S2 As String) As String
str5 = InStr(S1, S2)
End Function
6) Даны две строки: S1 и S2. Определить количество вхождений строки S2 в строку S1 (рисунок 21).
Рисунок 21 – Определение количество вхождений строки
Листинг программы:
Public Function str6(S1, S2 As String)
Dim i As Integer
Dim p As Integer
p = 0
f = Len(S2)
For i = 1 To Len(S1)
If Mid(S1, i, f) = S2 Then
p = p + 1
End If
Next
str6 = p
End Function
7) Дана строка S и символ C. Удвоить каждое вхождение символа C в строку S (рисунок 22).
Рисунок 22 – Удвоение вхождения символа
Листинг программы:
Public Function str7(C1, S As String) As String
str7 = Replace(C1, S, S + S)
End Function
8) Даны строки S1, S2 и символ C. Перед (после) каждого вхождения символа C в строку S1 вставить строку S2 (рисунок 23).
Рисунок 23 – Добавление строки в строку
Листинг программы:
Public Function str8(S1, S2, C As String) As String
str8 = Replace(S1, C, C + S2)
End Function
9) Даны две строки: S1 и S2. Удалить из строки S1 первую (последнюю) подстроки, совпадающие с S2. Если таких подстрок нет, то вывести S1 без изменений (рисунок 24).
Рисунок 24 – Удаление подстроки
Листинг программы:
Public Function str9(S1, S2 As String) As String
Dim p As String
If (InStr(S1, S2) <> 0) Then
N = InStr(S1, S2)
str9 = Left(S1, N - 1) + Right(S1, Len(S1) - ((N - 1) + Len(S2)))
Else
str9 = S1
End If
End Function
10) Даны три строки: S1, S2, S3. Заменить в строке S1 первое вхождения строки S2 на S3 (рисунок 25).
Рисунок 25 – Замена строки
Листинг программы:
Public Function str10(S1, S2, S3 As String) As String
Dim p As String
If (InStr(S1, S2) <> 0) Then
N = InStr(S1, S2)
str10 = Left(S1, N - 1) + S3 + Right(S1, Len(S1) - ((N - 1) +
Len(S2)))
Else
str10 = S1
End If
End Function
11) Дана строка, состоящая из русских слов, разделенных пробелами (одним или несколькими). Определить количество слов в строке (рисунок 26).
Рисунок 26 – Подсчет количества слов в строке
Листинг программы:
Public Function str11(S1 As String) As Integer
Dim i As Integer
Dim p As Integer
p = 0
S1 = Trim(S1)
For i = 1 To Len(S1)
If Mid(S1, i, 1) <> " " And Mid(S1, i + 1, 1) = " " Then
p = p + 1
End If
Next i
str11 = p + 1
End Function
12) Дана строка, состоящая из русских слов, разделенных пробелами (одним или несколькими). Определить количество слов, которые начинаются и заканчиваются одной и той же буквой (рисунок 27).
Рисунок 27 – Подсчет слов начинающихся и заканчивающихся на одну и ту же букву
Листинг программы:
Public Function str12(c1 As String) As String
Dim n As Integer, i As Integer, p1 As String, p2 As String
c1 = Trim(c1)
c1 = c1 + Space(1)
n = 0
i = 1
For i = 1 To Len(c1)
While Mid(c1, i, 1) = " "
i = i + 1
Wend
p1 = Mid(c1, i, 1)
i = i + 1
While Mid(c1, i, 1) <> " "
i = i + 1
Wend
p2 = Mid(c1, i - 1, 1)
If p1 = p2 Then n = n + 1
Next i
str12 = n
End Function
13) Дана строка, состоящая из русских слов, разделенных пробелами (одним или несколькими). Определить количество слов, которые содержат ровно три буквы "А" (рисунок 28).
Рисунок 28 – Подсчет количества слов имеющих 3 буквы “А”
Листинг программы:
Public Function str13(S1 As String) As String
Dim n As Integer, i As Integer, m As Integer
S1 = Trim(S1)
S1 = S1 + Space(1)
i = 1
m = 0
For i = 1 To Len(S1)
n = 0
While Mid(S1, i, 1) = " "
i = i + 1
Wend
While Mid(S1, i, 1) <> " "
If Mid(S1, i, 1) = "а" Or Mid(S1, i, 1) = "А" Then
n = n + 1
Else
n = n
End If
i = i + 1
Wend
If n = 3 Then
m = m + 1
Else
m = m
End If
Next i
str13 = m
End Function
14) Дана строка, состоящая из русских слов, разделенных пробелами (одним или несколькими). Определить длину самого короткого (длинного) слова (рисунок
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.