xXx.-всё_что_могут_задать_по_VBA

 функция вычисления суммы S=12+22+…+n2;
Public Function FunS(n)
Dim s As Integer
Dim i As Integer
s=0
For i = 1 To n
s=s+i^2
Next
FunS=s
End Function
 функция вычисления приближенного значения sin(x) по формуле у=x/1!-x3/3!+x5/5!….+x2n+1/(2n+1)! с заданной погрешностью;
Public Function sinus(x, погрешность)
i=2
p=x
s=x
While Abs(p) > погрешность
p = -p * x ^ 2 / (i * (i + 1))
i=i+2
s=s+p
Wend
sinus = s
End Function
Задание1 найти S 
n
1 / i , где n заданное число
i 1
Public Function FunSum(n)
s=0
For i = 1 To n
s=s+1/i
Next i
FunSum = s
End Function
Задание 3 вычисления суммы S=103+113+…+n3;
Public Function SumKub(n)
Dim s As Integer
Dim i As Integer
s=0
i = 10
While i <= n
s=s+i^3
i=i+1
Wend
SumKub = s
End Function
n
Задание 4 найти P   ( 2 * i )
i m
Public Function Proizv(m, n)
p=1
For i = m To n
p=p*2*i
Next i
Proizv = p
End Function
Задание 5 вычислить сумму кубов трехзначных четных чисел
Public Function Sum1()
p=0
For i = 100 To 999
p = p +i^3
Next i
Sum1= p
End Function
Задание 6 вычислить сумму квадратов тех четырехзначных чисел, которые при делении на 5 дают
в остатке 2
Public Function SumKvCh()
s=0
For i = 1000 To 9999
If i Mod 5 = 2 Then
s=s+i^2
End If
Next i
SumKvCh = s
End Function
Задание 7 найти сумму всех несократимых дробей, со знаменателем к, содержащихся между
целыми числами m и n, где к простое число;
Public Function drobi(m, n, k)
s=0
For i = k * m To k * n
If i Mod k <> 0 Then
s=s+i/k
End If
Next i
drobi = s
End Function
Задание 8 найти сумму S=1*100+2*99+3*98+…+ 50 *51
Public Function SummPr()
s=0
For i = 1 To 50
s = s + i * (101 - i)
Next i
SummPr = s
End Function
Задание 13 вычисления суммы S= 1!+2!+3!+……+ n!;
Public Function SumFactor(n)
p=1
s=0
For i = 1 To n
p=p*i
s=s+p
Next i
SumFactor = s
End Function
Задание 12 нахождения такой суммы S=1+2+3+…, для которой |S-M| минимально. M –
заданное число;
Public Function Summin(m)
s=0
i=1
While s <= m
tn = s
s=s+i
i=i+1
Wend
If s - m < m - tn Then
Summin = s
Else
Summin = tn
End If
End Function
Задание 14 вычисления приближенного значения cos(x) по формуле у=1-x2/2!+x4/4!….+x2n/(2n)! для заданного числа n;
Public Function cosinus(x, n)
Public Function Fun14(x As Double, n As Double) As Double
Dim i As Double, i1 As Double
Dim s As Double
Dim p As Double
i=2
p=1
s=1
For i1 = 2 To n
p = -p * x ^ 2 / (i * (i - 1))
s=s+p
i=i+2
Next
Fun14 = s
End Function
Задание 15 вычисления приближенного значения ex по формуле
x x2
xn
y 1 
 ... 
 ..., с заданной точностью E;
1! 2!
n!
Public Function ekspon(x, E)
i=1
p=1
s=1
While Abs(p) > E
p = (p * x) / i
i=i+1
s=s+p
Wend
ekspon = s
End Function
Public Function Простое_число(k As Integer) As String
'Является k простым числом или нет
Dim i As Integer
For i = 2 To k - 1
If k Mod i = 0 Then Exit For
Next i
If i < k - 1 Or k = 0 Or k = 1 Then
Простое_число = "Нет"
Else
Простое_число = "Да"
End If
End Function
Лабораторная работа №5_3. Разработка функций обработки целых
чисел.
Примеры функций
 функция нахождения суммы цифр целого числа n;
Public Function сумма_цифр_числа(n)
s=0
While n <> 0
c = n Mod 10
s=s+c
n = n \ 10
Wend
сумма_цифр_числа = s
End Function
 функция нахождения НОД двух натуральных чисел a и b
Public Function НОД(a, b)
While a <> b
If a > b Then
a=a-b
Else
b=b-a
End If
Wend
НОД = a
End Function
Задание 1получения числа, записанного цифрами заданного числа в обратном порядке;
Public Function Fun1(n)
While n <> 0
c = n Mod 10
s = s * 10 + c
n = n \ 10
Wend
Fun1 = s
End Function
Задание 2 нахождения суммы делителей числа N.
Public Function Fun2 (k)
p=0
For i = 1 To k
If k Mod i = 0 Then
p=p+i
End If
Next
Fun2 = p
End Function
Нок двух
Public Function NOK(a, b)
Dim X As Integer
Dim y As Integer
NOK = X * y / NOD(a, b)
End Function
Нод трех
Public Function NOD3(a, b, c)
d = NOD(a, b)
If a * b * c <> 0 Then
While c <> d
If Abs(c) > d Then
c = Abs(c) - d
Else
d = d - Abs(c)
End If
Wend
NOD3 = c
Else
NOD3 = “ ошибка ”
End If
End Function
Public Function NOK3(a, b, c)
d = NOK(a, b)
If a * b * c <> 0 Then
NOK3 = d * c / NOD(d, c)
Else
NOK3 = ‘ошибка’
End If
End Function
Задание 4 вычисления суммы первых n чисел Фибоначчи (числа Фибоначчи 1,1,2,3,5,8 и
т.д., т.е. каждое последующее число равно сумме двух предыдущих).
Public Function Fibonachi(n)
If n <= 2 Then
Fibonachi = 1
Exit Function
End If
Fibonachi = Fibonachi(n - 1) + Fibonachi(n - 2)
End Function
Public Function Summafib(n)
s=0
For i = 1 To n
s = s + Fibonachi(i)
Next
Summafib = s
End Function
Задание 5 определения, является ли число простым (число называется простым, если оно
делится только на 1 и на само число)
Public Function Prostoe(ByVal n As Long) As Boolean
Dim i As Integer
n = Abs(n)
i=2
Do While i < n
If n Mod i <> 0 Then
i=i+1
Else
Exit Do
End If
Loop
If i >= n Then Prostoe = True Else Prostoe = False
End Function
Public Function Prostoe2(ByVal n As Long) As Boolean
Dim i As Integer, Koren As Double
If n Mod 2 <= 0 And n <> 2 Or n <= 1 Or n <= 0 Then
Prostoe2 = False
Else
i=3
Koren = Sqr(n)
While i <= Koren And n Mod i <> 0
i=i+2
Wend
If i > Koren Then Prostoe2 = True Else Prostoe2 = False
End If
End Function
Задание 6 определения, является ли заданное число N совершенным. Число называется
совершенным, если оно равно сумме своих правильных (меньше этого числа) делителей
(6=1+2+3).
Public Function Soversh(ByVal n As Long) As Boolean
s=0
For i = 1 To (n - 1)
If n Mod i = 0 Then
s=s+i
Else
s=s
End If
Next
If s = n Then Soversh = True Else Soversh = False
End Function
Задание 7 определения, является ли заданное число N автоморфным. Число называется
автоморфным, если после возведения в квадрат оно совпадает с младшими разрядами
числа (52=25, 252=625).
Public Function avtomorf(n)
c = (n ^ 2) Mod 10 ^ kolcifr(n)
If n = c Then
avtomorf = "истина"
Else
avtomorf = "ложь"
End If
End Function
Задание 8 определения, является ли заданное число P числом Армстронга. Число,
состоящее из n цифр, называется числом Армстронга, если оно равно сумме n-х степеней
своих цифр (153= 13+53+33).
Public Function armstrong(ByVal R)
s=0
Rnach = R
a = kolcifr(R)
While R <> 0
c = R Mod 10
s=s+c^a
R = R \ 10
Wend
If Rnach = s Then
armstrong = "истина"
Else
armstrong = "ложь"
End If
End Function
Задание 9 определения, является ли заданное число N полиндромом. Полиндромом
называется число, которое читается одинаково слева направо и справа налево (121,676 и
т.д.).
Public Function polindrom(n)
If n = число_обр(n) Then
polindrom = "истина"
Else
polindrom = "ложь"
End If
End Function
Public Function Polindr(ByVal n As Double) As Boolean
m=n
While m <> 0
i = m Mod 10
s = s * 10 + i
m = m \ 10
Wend
If s = n Then Polindr = True Else Polindr False
End Function
Количество цифр
Public Function kolich(ByVal m As Double)
s=0
While m <> 0
s=s+1
m = m \ 10
Wend
kolich = s
End Function
Задание 14.На отрезке [n, m] найти все числа Армстронга.
Public Function Fun1(n, m)
s = ""
For i = n To m
If Armstrong(i) Then s = s + Str(i) + ", "
Next
Fun1 = s + "-числа Армстронга на отрезке [" + Str(n) + ", " + Str(m) + "]"
End Function
Задание 15 На отрезке [n, m] найти все числа близнецы. Два простых числа называются
близнецами, если расстояние между ними равно 2.
Public Function blizn(n, m)
blizn = ""
ipred = 0
For i = n To m
If prostoe_chislo(i) Then
If ipred <> 0 And i - ipred = 2 Then
blizn = blizn & Str(ipred) & "," & Str(i) & ";" & " "
End If
ipred = i
End If
Next i
End Function
Лабораторная работа №5_4. Разработка процедур и функций обработки
массивов
 функция вычисления суммы элементов массива А
1-й способ
Public Function Сумма_массива(A As Variant)
Dim s, x
s=0
For Each x In A
s=s+x
Next x
Сумма_массива = s
End Function
2-й способ
Public Function SumMas(a As Variant)
n = a.Columns.Count 'количество столбцов
m = a.Rows.Count ' количество строк
s=0
For r = 1 To m
For c = 1 To n
s = s + a(r, c)
Next c
Next r
SumMas=s
End Function
 функция подсчета количества положительных элементов массива А
Public Function CountP(a As Variant)
n = a.Columns.Count
m = a.Rows.Count
k= 0
For r = 1 To m
For c = 1 To n
If a(r,c) > 0 Then k=k+1
Next c
Next r
CountP=k
End Function
 нахождения максимального и минимального значения массива А
Public Function max_min_A(a As Variant)
n = a.Columns.Count
m = a.Rows.Count
minimal = a(1, 1)
maximal = a(1, 1)
For r = 1 To m
For c = 1 To n
If a(r, c) < minimal Then minimal = a(r, c)
If a(r, c) > maximal Then maximal = a(r, c)
Next c
Next r
max_min_A = "Минимальный эл-т:" + Str(minimal) + ", максимальный эл-т:" +
Str(maximal)
End Function
Задание 2.нахождения суммы (количества)
(нечетных) местах;
Public Function CountP(a As Variant)
n = a.Columns.Count
m = a.Rows.Count
элементов массива стоящих на четных
k=0
For r = 1 To m
For c = 1 To n
If r Mod 2 = 0 And c Mod 2 = 0 Then k = k + 1
Next c
Next r
CountP = k
End Function
Public Function Chetn(a As Variant)
n = a.Columns.Count
m = a.Rows.Count
k=0
For r = 2 To m Step 2
For c = 2 To n Step 2
k=k+1
Next c
Next r
Chetn = k
End Function
Задание 4. подсчета количества отрицательных (положительных, нулевых, кратных k)
элементов массива;
Public Function Sumkrat(k, A As Variant)
S=0
n = A.Columns.Count
m = A.Rows.Count
For r = 1 To m
For c = 1 To n
If A(r, c) Mod k = 0 Then S = S + A(r, c)
Next c
Next r
Sumkrat = S
End Function
Задание 6. нахождения НОД (НОК) элементов массива;
'NOD
Public Function NOD(ByVal A, ByVal B)
x = Abs(A)
y = Abs(B)
If x * y <> 0 Then
While x <> y
If x > y Then x = x - y Else y = y - x
Wend
NOD = x
Else
NOD = "ошибка"
End If
End Function
'NOD массива
Public Function NODmassiv(A As Variant)
n = A.Columns.Count
m = A.Rows.Count
NOD1 = NOD(A(1, 1), A(1, 2))
For r = 1 To m
For c = 1 To n
NOD2 = NOD(NOD1, A(r, c))
If NOD1 > NOD2 Then
NOD1 = NOD2
End If
Next c
Next r
NODmassiv = NOD2
End Function
'NOK
Public Function NOK(ByVal A, ByVal B)
x = Abs(A)
y = Abs(B)
If x * y <> 0 Then
NOK = (y * x) / NOD(A, B)
Else
NOK = "ошибка"
End If
End Function
'NOK масства
Public Function NOKmassiv(A As Variant)
n = A.Columns.Count
m = A.Rows.Count
NOK1 = NOK(A(1, 1), A(1, 2))
For r = 1 To m
For c = 1 To n
NOK2 = NOK(NOK1, A(r, c))
If NOK1 < NOK2 Then
NOK1 = NOK2
End If
Next c
Next r
NOKmassiv = NOK2
End Function
Задание 7.нахождения минимального (максимального) элемента массива и места его
расположения в массиве (номера строки и номера столбца);
Public Function maximel(A As Variant)
n = A.Columns.Count
m = A.Rows.Count
Maximal = A(1, 1)
For r = 1 To m
For c = 1 To n
If A(r, c) > Maximal Then
Maximal = A(r, c)
strok = r
stolb = c
End If
Next c
Next r
maximel = "максимальный элемент" + ":" + Str(Maximal) + "(" + Str(strok) + "," + Str(stolb) + ")"
End Function
Задание 8. нахождения максимального среди отрицательных (минимального среди
положительных элементов массива);
Public Function maxotr(A As Variant)
n = A.Columns.Count
m = A.Rows.Count
For r = 1 To m
For c = 1 To n
If A(r, c) < 0 Then otr = A(r, c)
Next c
Next r
For r = 1 To m
For c = 1 To n
If A(r, c) < 0 And A(r, c) > otr Then otr = A(r, c)
Next c
Next r
maxotr = otr
End Function
Задание 9. Нахождения двух самых больших (самых маленьких) элементов массива
Public Function dbabolsh(A As Variant)
n = A.Columns.Count
m = A.Rows.Count
maxel = A(1, 1)
For r = 1 To m
For c = 1 To n
If A(r, c) > maxel Then maxel = A(r, c)
Next c
Next r
max1 = maxel
max2 = A(1, 1)
For r = 1 To m
For c = 1 To n
If A(r, c) < max1 And A(r, c) > max2 Then max2 = A(r, c)
Next c
Next r
max3 = max2
dbabolsh = "1-ый максим." + ":" + Str(max1) + ";" + " " + "2-ой максим." + ":" + Str(max3)
End Function
Задание 10. расположения элементов массива в следующем порядке – положительные,
отрицательные и нулевые;
'Вспомогательная функция
Public Function ves(ByVal A)
If A > 0 Then
ves = 1
ElseIf A < 0 Then
ves = 2
Else
ves = 3
End If
End Function
Public Function polotrnul(A As Variant)
n = A.Columns.Count
m = A.Rows.Count
k=n*m
ReDim B(1 To k)
For i = 1 To k
B(i) = A(i)
Next i
For i = 1 To k - 1
For j = i + 1 To k
If ves(B(j)) < ves(B(i)) Then
p = B(j)
B(j) = B(i)
B(i) = p
End If
Next j
Next i
polotrnul = B
End Function
Public Function Massiv11(ByVal a As Variant) As Variant
Dim b() As Variant, n As Integer, t
'n = a.Columns.Count
n = UBound(a, 1)
ReDim b(1 To n)
For i = 1 To n
b(i) = a(i)
Next
For i = 1 To n - 1
For j = i + 1 To n
If b(i) < b(j) Then
t = b(i)
b(i) = b(j)
b(j) = t
End If
Next
Next
Massiv11 = b
End Function
Задание 12. в упорядоченном массиве, найти такие два элемента, произведение которых
максимально (минимально);
Public Function Massiv(a As Variant) As Variant
Dim b() As Variant
n = a.Columns.Count
ReDim b(1 To n)
For i = 1 To n
b(i) = a(i)
Next
For i = 1 To n - 1
For j = i + 1 To n
If b(i) < b(j) Then
t = b(i)
b(i) = b(j)
b(j) = t
End If
Next
Next
If b(n) * b(n - 1) < b(1) * b(2) Then
k = b(1) * b(2)
Else: k = b(n) * b(n - 1)
End If
If b(n) < 0 Then
l = b(n) * b(1)
Else: l = b(n) * b(n - 1)
End If
Massiv = Str(k) + "-максимальное произведение" + "; " + Str(l) + "-минимальное произведение"
End Function
Лабораторная работа №5_5.
Разработка функций обработки многочленов, векторов и матриц на VBA
Примеры функций обработки многочленов, векторов и матриц

функция вычисления значения многочлена Pn(x) в точке Х0
Public Function Значение_Полинома_в_Точке(a As Variant, x As Double)
‘ функция вычисления значения многочлена Pn(x) в точке Х0
Dim n As Integer
Dim i As Integer
Dim p As Double
n = a.Columns.Count
p = a(1)
For i = 2 To n
p = p * x + a(i)
Next i
Значение_Полинома_в_Точке = p
End Function
 функция вычисления суммы двух многочленов Pm(x) и Qn(x)
Public Function Коэффициенты_суммы_двух_полиномов (A As Variant, b As Variant)
‘ Коэффициенты суммы двух полиномов
Dim M As Integer
Dim N As Integer
Dim I As Integer
M = A.Columns.Count
N = b.Columns.Count
If M >= N Then
ReDim c(1 To M) As Variant
Else
ReDim c(1 To N) As Variant
End If
If M = N Then
For I = 1 To M
c(I) = A(I) + b(I)
Next I
End If
If M > N Then
For I = 1 To M - N
c(I) = A(I)
Next I
For I = 1 To N
c(M - N + I) = A(M - N + I) + b(I)
Next I
End If
If N > M Then
For I = 1 To N - M
c(I) = b(I)
Next I
For I = 1 To M
c(N - M + I) = b(N - M + I) + A(I)
Next I
End If
Коэффициенты_суммы_двух_ полиномов = c
End Function
В результате выполнения функции должен получиться массив коэффициентов нового
многочлена. Поэтому для вызова функции необходимо вначале выделить необходимый
диапазон ячеек для результата, после чего вызвать функцию и завершить вызов функции
комбинацией клавиш CTRL+Shift+Enter

функция вычисления сумм столбцов матрицы
Public Function Сумма_по_столбцам (Матрица As Variant)
‘ функция вычисления сумм столбцов матрицы и получения вектора сумм
Dim M As Integer, N As Integer, I As Integer, J As Integer
M = Матрица.Rows.Count
N = Матрица.Columns.Count
ReDim b(1 To N) As Variant
For J = 1 To N
b(J) = 0
For I = 1 To M
b(J) = b(J) + Матрица (I, J)
Next I
Next J
Сумма_по_столбцам = b
End Function
В результате выполнения функции должен получиться массив сумм столбцов матрицы.
Поэтому для вызова функции необходимо вначале выделить необходимый диапазон
ячеек для сумм столбцов, а затем вызвать функцию и завершить вызов функции
комбинацией клавиш CTRL+Shift+Enter
Задание 2. найти коэффициенты производной от полинома Pn(x), т.е. найти многочлен Rn1=
(Pn(x))'
Public Function Proizv(A As Variant)
Dim b() As Variant
Dim M As Integer
Dim I As Integer
M = A.Columns.Count
ReDim b(1 To M)
For I = 1 To M
b(I) = A(I) * (M - I)
Next I
Proizv = b
End Function
Задание 3. найти коэффициенты первообразной от полинома Pn(x);
Public Function Pervoobr(A As Variant)
Dim b() As Variant
Dim M As Integer
Dim I As Integer
M = A.Columns.Count
ReDim b(1 To M)
For I = 1 To M
b(I) = A(I) / (M + 1 - I)
Next I
Pervoobr = b
End Function
Задание 7. найти произведение двух полиномов
Public Function Proizv(a As Variant, b As Variant) As Variant
Dim n, m, i, j As Integer
Dim c(): n = a.Columns.Count
m = b.Columns.Count
ReDim c(1 To m + n - 1)
For i = 1 To n
For j = 1 To m
c(i + j - 1) = c(i + j - 1) + a(i) * b(j)
Next j
Next i
Proizv= c
End Function
Лабораторная работа №5_6.
Разработка функций обработки строк и текстовой информации на VBA
Примеры функций обработки строк
функция подсчета количества символа пробел в строке
Public Function CountSpace(s As String) As Integer
‘ функция подсчета количества символа пробел в строке
Dim i As Integer
Dim p As Integer
p=0
For i = 1 To Len(s)
If Mid(s, i, 1) = " " Then
p=p+1
End If
Next
CountSpace = p
End Function
Задание 1. Сформировать строку длины N (N — четное), которая состоит из
чередующихся символов C1 и C2, начиная с C1.
Public Function Fun1(N As Integer, c1 As String, c2 As String) As String
Dim i As Integer
Dim S As String
S = ""
If N Mod 2 = 0 Then
For i = 1 To N / 2
S = S + c1 + c2
Next
Else
S = ""
End If
Fun1 = S
End Function
Задание 3. Дана строка S и число N. Преобразовать строку S в строку длины N следующим
образом: если длина строки S больше N, то отбросить первые символы, если длина строки
S меньше N, то в ее начало добавить символы "." (точка).
Public Function Fun3(S As String, N As Integer) As String
If Len(S) > N Then
Fun3 = Right(S, N)
Else
Fun3 = String(N - Len(S), ".") + S
End If
End Function
Задание 2. Дана строка. Получить строку, содержащую те же символы, но расположенные
в обратном порядке.
Public Function Fun2(S As String) As String
Fun2 = StrReverse(S)
End Function
Public Function Fun2_(S As String) As String
Dim i As Integer
Dim p As String
p = ""
For i = Len(S) To 1 Step -1
p = p + Mid(S, i, 1)
Next
Fun2_ = p
End Function
Задание 3. Дана строка S и число N. Преобразовать строку S в строку длины N
следующим образом: если длина строки S больше N, то отбросить первые символы, если
длина строки S меньше N, то в ее начало добавить символы "." (точка).
Public Function Fun3(S As String, N As Integer) As String
If Len(S) > N Then
Fun3 = Right(S, N)
Else
Fun3 = String(N - Len(S), ".") + S
End If
If s = n Then fun3 = s
End Function
Задание 4.Даны два числа: N1 и N2, и две строки: S1 и S2. Получить из этих строк новую
строку, объединив N1 первых символов строки S1 и N2 последних символов строки S2.
Public Function Fun4(N1 As Integer, N2 As Integer, S1 As String, S2 As String) As String
Fun4 = Left(S1, N1) + Right(S2, N2)
End Function
Задание5. Даны две строки: S1 и S2. Проверить, содержится ли строка S2 в строке S1.
Если да, то вывести номер позиции, начиная с которой S2 содержится в S1, если нет, то
вывести 0.
Public Function Fun5(S1 As String, S2 As String) As Integer
Fun5 = InStr(S1, S2)
End Function
Public Function fun2(s1 As String, s2 As String) As Double
Dim a As Double, i As Integer, j As Integer, t As Integer
a=0
i = Len(s1)
j = Len(s2)
For t = 1 To i
If Mid(s1, t, j) = s2 Then
a=t
End If
If a <> 0 Then
Exit For
End If
Next t
fun2 = a
End Function
Задание 6.Даны две строки: S1 и S2. Определить количество вхождений строки S2 в
строку S1.
Public Function Fun6(S1 As String, S2 As String) As Integer
Dim k As Integer
Dim N As Integer
k=0
N = InStr(1, S1, S2)
While N > 0
k=k+1
N = InStr(N + 1, S1, S2)
Wend
Fun6 = k
End Function
Задание 7. Дана строка S и символ C. Удвоить каждое вхождение символа C в строку S.
Public Function Fun7(S As String, C As String) As String
Fun7 = Replace(S, C, C + C)
End Function
Задание 8. Даны строки S1, S2 и символ C. Перед (после) каждого вхождения символа C в
строку S1 вставить строку S2.
Public Function Fun8(S1 As String, S2 As String, C As String) As String
Fun8 = Replace(S1, C, S2 + C)
End Function
Задание 9. Даны две строки: S1 и S2. Удалить из строки S1 первую (последнюю)
подстроки, совпадающие с S2. Если таких подстрок нет, то вывести S1 без изменений.
Public Function Fun9(S1 As String, S2 As String) As String
Dim N As Integer
Dim k As Integer
N = InStr(1, S1, S2)
Fun9 = Left(S1, N - 1) + Right(S1, Len(S1) - (N - 1 + Len(S2)))
End Function
Задание 10. Даны три строки: S1, S2, S3. Заменить в строке S1 первое вхождения строки
S2 на S3.
Public Function Fun10(S1 As String, S2 As String, S3 As String) As String
Dim N As Integer
N = InStr(1, S1, S2)
Fun10 = Replace(S1, S2, S3, N - 1)
End Function
Задание 11. Дана строка, состоящая из русских слов, разделенных пробелами (одним или
несколькими). Определить количество слов в строке.
Public Function Fun11(s As String) As String
Dim i As Integer, a As Integer
a=1
If Len(s) = 0 Then
a=0
Else
For i = 1 To Len(s)
If Mid(s, i, 1) <> " " And Mid(s, i + 1, 1) = " " Then
a=a+1
End If
Next i
End If
Fun11= "Количество слов в строке: " + Format(a)
End Function
Задание12. Дана строка, состоящая из русских слов, разделенных пробелами (одним или
несколькими). Определить количество слов, которые начинаются и заканчиваются одной
и той же буквой.
Public Function Fun12(s As String) As String
Dim c As String, n As Integer, i As Integer, perv As String, posl As String
c=s+""
n=0
i=1
While i <= Len(c)
While Mid(c, i, 1) = " "
i=i+1
Wend
perv = Mid(c, i, 1)
i=i+1
While Mid(c, i, 1) <> " "
i=i+1
Wend
posl = Mid(c, i - 1, 1)
If perv = posl Then n = n + 1
i=i+1
Wend
Fun12 = "Количество слов, которые начинаются и заканчиваются одной и той же буквой: "
+ Str(n)
End Function
Задание13. Дана строка, состоящая из русских слов, разделенных пробелами (одним или
несколькими). Определить количество слов, которые содержат ровно три буквы "А".
Public Function Fun13(s As String) As String
Dim c As String, i As Integer, n As Integer, m As Integer
c=s+""
i=1
While i <= Len(c)
n=0
While Mid(c, i, 1) = " "
i=i+1
Wend
i=i+1
While Mid(c, i, 1) <> " "
If Mid(c, 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
i=i+1
Wend
Fun13 = "Количество слов..: " + Str(m)
End Function
Задание14.Дана строка, состоящая из русских слов, разделенных пробелами (одним или
несколькими). Определить длину самого короткого (длинного) слова.
Public Function Fun14(s As String) As String
Dim c As String, i As Integer, n As Integer, m As Integer
c=s+""
m = 100
i=1
While i <= Len(c)
n=1
While Mid(c, i, 1) = " "
i=i+1
Wend
i=i+1
While Mid(c, i, 1) <> " "
n=n+1
i=i+1
Wend
If n < m Then m = n
i=i+1
Wend
Fun14 = Длина самого короткого слова: " + Str(m)
End Function
Задание 15. Дана строка-предложение на русском языке. Вывести самое короткое
(длинное) слово в предложении (если таких слов несколько, то вывести первое из них).
Public Function Fun15(s As String) As String
Dim c As String, i As Integer, n As Integer, m As Integer
c=s+""
m = 100
i=1
Dim sl As String
While i <= Len(c)
n=0
sl = ""
While Mid(c, i, 1) = " "
i=i+1
Wend
While Mid(c, i, 1) <> " "
n=n+1
sl = sl + Mid(c, i, 1)
i=i+1
Wend
If n < m Then m = n: Fun15 = "Ñàìîå êîðîòêîå ñëîâî â ïðåäëîæåíèè: " + sl
i=i+1
Wend
End Function
Задание 16. Дана строка-предложение, содержащая избыточные пробелы. Преобразовать
ее так, чтобы между словами был ровно один пробел.
Public Function Fun16(s As String) As String
Dim n As Integer
n = InStr(1, s, " ")
While n <> 0
s = Mid(s, 1, n - 1) + " " + Mid(s, n + 2, Len(s))
n = InStr(1, s, " ")
Wend
Fun16 = s
End Function