Пример. Функция подсчета количества символа пробел в строке Public Function Count_Space(s As String) As String Dim i, p As Integer p = 0 For i = 1 To Len(s) If Mid(s, i, 1) = " " Then p = p + 1 End If Next i Count_Space = "Количество пробелов: " + Format(p) End Function
| Сформировать строку длины N (N — четное), которая состоит из чередующихся символов C1 и C2, начиная с C1. Public Function Чередующиеся_символы(n As Integer, c1 As String, c2 As String) As String Dim s As String, i As Integer s = "" If n Mod 2 = 0 Then For i = 1 To n / 2 s = s + c1 + c2 Next i Else s = "N не является четным числом" End If Чередующиеся_символы = s End Function
|
'2. Дана строка. Получить строку, содержащую те же символы, но расположенные в обратном порядке. Public Function Обратный_порядок(a As String) As String Dim n As Integer, i As Integer, s As String s = "" n = Len(a) For i = n To 1 Step -1 s = s + Mid(a, i, 1) Next i Обратный_порядок = s End Function
'Второй способ решения задачи 2. Public Function Обратный_порядок_способ_2(a As String) As String Обратный_порядок_способ_2 = StrReverse(a) End Function
| '3. Дана строка S и число N. Преобразовать строку S в строку длины N следующим образом: если длина строки S больше N, то отбросить первые символы, если длина строки S меньше N, то в ее начало добавить символы "." (точка). Public Function Преобразовать_строку_S_в_строку_длины_N(s As String, n As Integer) As String Dim i As Integer, a As Integer, d As String, f As String f = "" a = Len(s) If a > n Then d = Right(s, n) Else If a < n Then f = String(n - a, ".") d = Format(f) + Format(s) End If End If If a = n Then d = Format(s) Преобразовать_строку_S_в_строку_длины_N = d End Function
|
'4. Даны два числа: N1 и N2, и две строки: S1 и S2. Получить из этих строк новую строку, объединив N1 первых символов строки S1 и N2 последних символов строки S2. Public Function Получение_строки_S3(n1 As Integer, n2 As Integer, s1 As String, s2 As String) As String Dim s3 As String s3 = Left(s1, n1) + Right(s2, n2) Получение_строки_S3 = s3 End Function
| '5. Даны две строки: S1 и S2. Проверить, содержится ли строка S2 в строке S1. Если да, то вывести номер позиции, начиная с которой S2 содержится в S1, если нет, то вывести 0. Public Function Содержится_ли_S2_в_S1(s1 As String, s2 As String) As Double Содержится_ли_S2_в_S1 = InStr(s1, s2) End Function
' Второй способ решения задачи 5. Public Function Содержится_ли_S2_в_S1_способ_2(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 Содержится_ли_S2_в_S1_способ_2 = a End Function
|
'8. Даны строки S1, S2 и символ C. Перед (после) каждого вхождения символа C в строку S1 вставить строку S2 Public Function Перед_и_после_С_вставить_S2_в_строку_S1(s1 As String, s2 As String, c As String) As String Dim a As String, i As Integer, s3 As String, s4 As String, t As Integer, q As String i = Len(s1) s3 = "" s4 = "" For t = 1 To i a = Mid(s1, t, 1) q = Mid(s1, t, 1) If a = c Then a = s2 + c q = c + s2 Else a = Mid(s1, t, 1) q = Mid(s1, t, 1) End If s3 = s3 + a s4 = s4 + q Next t Перед_и_после_С_вставить_S2_в_строку_S1 = "Вставка S2 перед каждым С: " + s3 + "; Вставка S2 после каждого С: " + s4 End Function
| |
'9. Даны две строки: S1 и S2. Удалить из строки S1 первую (последнюю) подстроки, совпадающие с S2. Если таких подстрок нет, то вывести S1 без изменений. Public Function Удаление_первой_подстроки_S2_из_S1(s1 As String, s2 As String) As String Dim n As Integer n = InStr(s1, s2) If n <> 0 Then Удаление_первой_подстроки_S2_из_S1 = Mid(s1, 1, n - 1) + Mid(s1, n + Len(s2)) Else Удаление_первой_подстроки_S2_из_S1 = s1 End If End Function
'Второй способ решения задачи 9. Public Function Удаление_подстроки_S2_из_S1_способ_2(s1 As String, s2 As String) As String Dim a, s3, s4 As String, i, j, t, q As Integer i = Len(s1) j = Len(s2) q = 0 For t = 1 To i a = Mid(s1, t, j) If a = s2 Then q = t s3 = Mid(s1, 1, t - 1) + Mid(s1, t + j) End If If q <> 0 Then Exit For End If Next t For t = 1 To i a = Mid(s1, t, j) If a = s2 Then q = t End If Next t s4 = Mid(s1, 1, q - 1) + Mid(s1, q + j) Удаление_подстроки_S2_из_S1_способ_2 = "Удалить из строки S1 первую подстроку: " + s3 + "; Удалить из строки S1 последнюю подстроку: " + s4 End Function
| ' 10. Даны три строки: S1, S2, S3. Заменить в строке S1 первое вхождения строки S2 на S3. Public Function Заменить_S2_на_S3_в_S1(s1 As String, s2 As String, s3 As String) As String Dim n As Integer n = InStr(1, s1, s2) Заменить_S2_на_S3_в_S1 = Mid(s1, 1, n - 1) + s3 + Mid(s1, n + Len(s2)) End Function
'Второй способ решения задачи 10. Public Function Заменить_S2_на_S3_в_S1_способ_2(s1 As String, s2 As String, s3 As String) As String Dim a, s4 As String, i, j, t, q As Integer i = Len(s1) j = Len(s2) q = 0 For t = 1 To i a = Mid(s1, t, j) If a = s2 Then q = t s4 = Mid(s1, 1, t - 1) + s3 + Mid(s1, t + j) End If If q <> 0 Then Exit For End If Next t Заменить_S2_на_S3_в_S1_способ_2 = s4 End Function
|
'11. Дана строка, состоящая из русских слов, разделенных пробелами (одним или несколькими). Определить количество слов в строке. Public Function Количество_слов_в_строке(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 Количество_слов_в_строке = "Количество слов в строке: " + Format(a) End Function
| '12. Дана строка, состоящая из русских слов, разделенных пробелами (одним или несколькими). Определить количество слов, которые начинаются и заканчиваются одной и той же буквой Public Function Количество_слов_в_строке_2(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 Количество_слов_в_строке_2 = "Количество слов, которые начинаются и заканчиваются одной и той же буквой: " + Format(n) End Function
|
'13. Дана строка, состоящая из русских слов, разделенных пробелами (одним или несколькими). Определить количество слов, которые содержат ровно три буквы "А". Public Function Количество_слов_в_строке_3(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 Количество_слов_в_строке_3 = "Количество слов, которые содержат ровно три буквы А: " + Format(m) End Function
| '14. Дана строка, состоящая из русских слов, разделенных пробелами (одним или несколькими). Определить длину самого короткого (длинного) слова. Public Function Длина_самого_короткого_слова(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 Длина_самого_короткого_слова = "Длина самого короткого слова: " + Format(m) End Function
|
'15. Дана строка-предложение на русском языке. Вывести самое короткое (длинное) слово в предложении (если таких слов несколько, то вывести первое из них). Public Function Самое_короткое_слово_в_предложении(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: Самое_короткое_слово_в_предложении = "Самое короткое слово в предложении: " + sl i = i + 1 Wend End Function
| '16. Дана строка-предложение, содержащая избыточные пробелы. Преобразовать ее так, чтобы между словами был ровно один пробел. Public Function Убрать_избыточные_пробелы(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 Убрать_избыточные_пробелы = s End Function
|
Public Sub Сумма_элементов_матрицы() Dim m, n, i, j As Integer, a As Range, s As Double Set a = Selection m = a.Rows.Count n = a.Columns.Count For i = 1 To m For j = 1 To n s = s + a(i, j) Next j Next i Cells(m + 2, 1) = s End Sub
| Public Sub Сумма_элементов_каждой_строки_и_столбца_2() Dim m, n, i, j As Integer, a As Range, s As Double Set a = Selection m = a.Rows.Count n = a.Columns.Count ReDim b(1 To m) ReDim c(1 To n) For i = 1 To m s = 0 For j = 1 To n s = s + a(i, j) Next j Cells(i, n + 2) = s Next i For j = 1 To n s = 0 For i = 1 To m s = s + a(i, j) Next i c(j) = s Cells(m + 2, j) = s Next j End Sub
|
Public Sub Сумма_элементов_каждой_строки_и_столбца_3() Dim m, n, i, j As Integer, a As Range, s, s1 As Double Set a = Selection m = a.Rows.Count n = a.Columns.Count s = 0 s1 = 0 ReDim b(1 To m) ReDim c(1 To n) For i = 1 To m s = 0 s1 = 0 For j = 1 To n s = s + a(i, j) s1 = s1 + a(i, j) Cells(m + 2, j) = s1 Next j Cells(i, n + 2) = s Next i End Sub
| 1. Вычислить значение многочлена Pn(x) в точке x0 по схеме Горнера; Public Function Значение_полинома_в_точке (a As Variant, x As Integer) As String Dim m, i, p As Integer m = a.Columns.Count p = a(1) For i = 2 To m p = p * x + a(i) Next i Значение_полинома_в_точке = "Значение Pn(x) в точке X0: " + Format(p) End Function
|
'2. Найти коэффициенты производной от полинома Pn(x), т.е. найти многочлен Rn-1= (Pn(x))' Public Function Коэффициенты_производной(a As Variant) As Variant Dim m, i As Integer m = a.Columns.Count ReDim s(1 To m) For i = 1 To m - 1 s(i) = a(i + 1) * i Next i s(m) = 0 Коэффициенты_производной = s End Function
| '3. Найти коэффициенты первообразной от полинома Pn(x); Public Function Коэффициенты_первообразной(a As Variant) As Variant Dim m, i As Integer m = a.Columns.Count ReDim s(1 To m + 1) s(1) = 0 For i = 1 To m s(i + 1) = a(i) / i Next i Коэффициенты_первообразной = s End Function
|
'4. Найти коэффициенты k-ой производной от полинома Pn(x); Public Function Коэффициенты_производной_2(a As Variant, k As Double) As Variant Dim n, i, w, q As Integer Dim c() n = a.Columns.Count ReDim c(1 To n) For i = 1 To n c(i) = a(i) Next i For w = 1 To k For q = n To 2 Step -1 c(q) = c(q - 1) * (n - q + 1) Next q c(w) = 0 Next w Коэффициенты_производной_2 = c End Function
| '5. Найти коэффициенты k-ой первообразной от полинома Pn(x); Public Function Коэффициенты_первообразной_2(a As Variant, k As Double) As Variant Dim n, i, w, q As Integer Dim c() n = a.Columns.Count ReDim c(1 To n + k) For i = 1 To n c(i) = a(i) Next i For w = 1 To k For q = 1 To n c(q) = c(q) / (n - q + w) Next q c(n + w) = 0 Next w Коэффициенты_первообразной_2 = c End Function
|
'6. найти сумму (разность) двух полиномов Pn(x) и Qm( x); Public Function Сумма_двух_полиномов(a As Variant, b As Variant) As Variant Dim n, m, l, kon, i As Integer, uk As Boolean Dim c() n = a.Columns.Count m = b.Columns.Count If m > n Then l = m kon = m - n uk = True Else l = n kon = n - m uk = False End If ReDim c(1 To l) For i = 1 To kon If uk Then c(i) = b(i) Else c(i) = a(i) Next i For i = kon + 1 To l If uk Then c(i) = a(i - kon) + b(i) Else c(i) = a(i) + b(i - kon) Next i Сумма_двух_полиномов = c End Function
| '7. найти произведение двух полиномов Pn(x) и Qm(x) Public Function Произведение_двух_полиномов(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 Произведение_двух_полиномов = c End Function
|
'8. Найти скалярное произведение двух n-мерных векторов X и Y; Public Function Скалярное_произведение_векторов(x As Variant, y As Variant) As Variant Dim c(), z(), f As Integer, s As Double, m As Integer, k As Integer, j As Integer, n As Integer, p As Integer, i As Integer m = x.Columns.Count n = y.Columns.Count If m <> n Then Скалярное_произведение_векторов = "Неверные данные" Exit Function Else p = m ReDim c(1 To m) For i = 1 To m c(i) = x(i) * y(i) Next i Скалярное_произведение_векторов = c() End If End Function
| '9. Найти произведение матрицы на вектор; Public Function Произведение_матрицы_на_вектор(a As Variant, b As Variant) As Variant Dim i, j, m, n, d, k As Integer, c As Variant m = a.Rows.Count n = a.Columns.Count i = b.Rows.Count j = 1 c = 0 ReDim c(1 To m) If n <> i Then Произведение_матрицы_на_вектор = "Не существует" Else For k = 1 To m c(k) = 0 For d = 1 To n c(k) = c(k) + a(k, d) * b(d, j) Next d Next k End If Произведение_матрицы_на_вектор = c End Function
|
'10а. Найти произведение (сумму) двух матриц Public Function Произведение_двух_матриц(a As Variant, b As Variant) As Variant Dim i, j, m, n, d, k, t As Integer, c As Variant m = a.Rows.Count n = a.Columns.Count i = b.Rows.Count j = b.Columns.Count c = 0 ReDim c(1 To m, 1 To j) If n <> i Then Произведение_двух_матриц = "Не существует" Else For k = 1 To m For t = 1 To j c(k, t) = 0 For d = 1 To n c(k, t) = c(k, t) + a(k, d) * b(d, t) Next d Next t Next k End If Произведение_двух_матриц = c End Function
| '10б. Найти сумму двух матриц Public Function Сумма_двух_матриц(a As Variant, b As Variant) As Variant Dim i, j, m, n, d, k As Integer, c As Variant m = a.Rows.Count n = a.Columns.Count i = b.Rows.Count j = b.Columns.Count c = 0 If n <> j And m <> i Then Сумма_двух_матриц = "Не существует" Else If n = j And m = i Then ReDim c(1 To m, 1 To n) For k = 1 To m For d = 1 To n c(k, d) = a(k, d) + b(k, d) Next d Next k End If End If Сумма_двух_матриц = c End Function
|
'11а. Найти сумму элементов каждой строки матрицы; Public Function Сумма_элементов_каждой_строки(a As Variant) As Variant Dim m As Integer, n As Integer, i As Integer, j As Integer Dim s As Integer m = a.Rows.Count n = a.Columns.Count ReDim b(1 To m) For i = 1 To m s = 0 For j = 1 To n s = s + a(i, j) Next j b(i) = s Next i Сумма_элементов_каждой_строки = b End Function
| '11б. Найти сумму элементов каждого столбца матрицы; Public Function Сумма_элементов_каждого_столбца(a As Variant) As Variant Dim m As Integer, n As Integer, i As Integer, j As Integer Dim s As Integer m = a.Rows.Count n = a.Columns.Count ReDim b(1 To n) For j = 1 To n s = 0 For i = 1 To m s = s + a(i, j) Next i b(j) = s Next j Сумма_элементов_каждого_столбца = b End Function
|
'12. Найти строку и столбец матрицы, на пересечении которых находится минимальный (максимальный) элемент матрицы; Public Function Место_расположения_Max_и_Min(a As Variant) As String Dim min As Variant, max As Variant, n As Double, m As Double, r As Integer, c As Integer, d As Integer, e As Integer, d1 As Integer, e1 As Integer n = a.Columns.Count m = a.Rows.Count min = a(1, 1) max = a(1, 1) For r = 1 To m For c = 1 To n If a(r, c) <= min Then min = a(r, c) d = r e = c End If If a(r, c) >= max Then max = a(r, c) d1 = r e1 = c End If Next c Next r Место_расположения_Max_и_Min = "Номер минимального (строка, столбец): " + Str(d) + "," + Str(e) + "; Номер максимального (строка, столбец): " + Str(d1) + "," + Str(e1) End Function
| '13. Найти строку и столбец матрицы, которые содержат наибольшее число нулевых элементов; Public Function Наибольшее_число_нулей(a As Variant) As String Dim m, n, i, j, q, s, w, t As Integer, b As Variant m = a.Rows.Count n = a.Columns.Count ReDim b(1 To m) For i = 1 To m q = 0 For j = 1 To n If a(i, j) = 0 Then q = q + 1 End If b(i) = q Next j Next i s = 1 t = b(1) For w = 1 To m If b(w) >= t Then t = b(w) s = w End If Next w If q = 0 Then Наибольшее_число_нулей = "Нет нулевых элементов" Наибольшее_число_нулей = "Строка, которая содержит наибольшее число нулевых элементов: " + Format(s) End Function
|
'13. Найти строку и столбец матрицы, которые содержат наибольшее число нулевых элементов; Public Function Наибольшее_число_нулей_2(a As Variant) As String Dim m, n, i, j, q, s, w, t As Integer, b As Variant m = a.Rows.Count n = a.Columns.Count ReDim b(1 To n) For j = 1 To n q = 0 For i = 1 To m If a(i, j) = 0 Then q = q + 1 End If b(j) = q Next i Next j s = 1 t = b(1) For w = 1 To n If b(w) >= t Then t = b(w) s = w End If Next w If q = 0 Then Наибольшее_число_нулей_2 = "Нет нулевых элементов" Наибольшее_число_нулей_2 = "Столбец, который содержит наибольшее число нулевых элементов: " + Format(s) End Function
| '14. Найти строку матрицы с максимальной (минимальной) суммой элементов; Public Function Строки_с_max_и_min_суммой(a As Variant) As Variant Dim m As Integer, n As Integer, i As Integer, j As Integer Dim s, w, max_s, min_s, t, t1 As Integer m = a.Rows.Count n = a.Columns.Count ReDim b(1 To m) For i = 1 To m s = 0 For j = 1 To n s = s + a(i, j) Next j b(i) = s Next i max_s = b(1) min_s = b(1) t = 1 t1 = 1 For w = 1 To m If b(w) >= max_s Then max_s = b(w) t = w End If If b(w) <= min_s Then min_s = b(w) t1 = w End If Next w Строки_с_max_и_min_суммой = "Строка с максимальной суммой элементов: " + Format(t) + "; Строка с минимальной суммой элементов: " + Format(t1) End Function
|
'14б. Найти столбец матрицы с максимальной (минимальной) суммой элементов; Public Function Столбцы_с_max_и_min_суммой(a As Variant) As Variant Dim m As Integer, n As Integer, i As Integer, j As Integer Dim s, w, max_s, min_s, t, t1 As Integer m = a.Rows.Count n = a.Columns.Count ReDim b(1 To n) For j = 1 To n s = 0 For i = 1 To m s = s + a(i, j) Next i b(j) = s Next j max_s = b(1) min_s = b(1) t = 1 t1 = 1 For w = 1 To n If b(w) >= max_s Then max_s = b(w) t = w End If If b(w) <= min_s Then min_s = b(w) t1 = w End If Next w Столбцы_с_max_и_min_суммой = "Столбец с максимальной суммой элементов: " + Format(t) + "; Столбец с минимальной суммой элементов: " + Format(t1) End Function
| '15. Найти среднее арифметическое (среднее геометрическое) положительных элементов матрицы; Public Function Среднее_арифметическое_и_среднее_геометрическое_положительных_элементов(a As Variant) As String Dim sa, sg, s, s1, k As Double, x As Variant s = 0 s1 = 1 k = 0 For Each x In a If x > 0 Then s = s + x s1 = s1 * x k = k + 1 End If Next x sa = s / k sg = s1 ^ (1 / k) Среднее_арифметическое_и_среднее_геометрическое_положительных_элементов = "Среднее арифметическое: " + Format(sa) + "; Среднее геометрическое: " + Format(sg) End Function '16а. Найти сумму (количество) элементов верхнего правого треугольника квадратной матрицы порядка n. Public Function Сумма_и_количество_элементов_верхнего_правого_треугольника(a As Variant) As String Dim i, j, m, n, k As Integer, s As Double m = a.Rows.Count n = a.Columns.Count s = 0 k = 0 For j = 1 To n For i = 1 To j s = s + a(i, j) k = k + 1 Next i Next j Сумма_и_количество_элементов_верхнего_правого_треугольника = "Сумма элементов верхнего правого треугольника: " + Format(s) + "; Количество элементов верхнего правого треугольника: " + Format(k) End Function
|
'16б. Найти сумму (количество) элементов нижнего левого треугольника квадратной матрицы порядка n. Public Function Сумма_и_количество_элементов_нижнего_левого_треугольника(a As Variant) As String Dim i, j, m, n, k As Integer, s As Double m = a.Rows.Count n = a.Columns.Count s = 0 k = 0 For j = 1 To n For i = j To m s = s + a(i, j) k = k + 1 Next i Next j Сумма_и_количество_элементов_нижнего_левого_треугольника = "Сумма элементов нижнего левого треугольника: " + Format(s) + "; Количество элементов нижнего левого треугольника: " + Format(k) End Function
| '16в. Сумма и количество элементов главной диагонали Public Function Сумма_и_количество_элементов_главной_диагонали(a As Variant) As String Dim i, j, m, n, k As Integer, s As Double m = a.Rows.Count n = a.Columns.Count s = 0 k = 0 For j = 1 To n For i = 1 To m If i = j Then s = s + a(i, j) k = k + 1 End If Next i Next j Сумма_и_количество_элементов_главной_диагонали = "Сумма элементов главной диагонали: " + Format(s) + "; Количество элементов главной диагонали: " + Format(k) End Function
|
'16в. Сумма и количество элементов главной диагонали Public Function Сумма_и_количество_элементов_главной_диагонали_2(a As Variant) As String Dim i, j, m, n, k As Integer, s As Double m = a.Rows.Count s = 0 k = 0 For i = 1 To m s = s + a(i, i) k = k + 1 Next i Сумма_и_количество_элементов_главной_диагонали_2 = "Сумма элементов главной диагонали: " + Format(s) + "; Количество элементов главной диагонали: " + Format(k) End Function
| 'Пример 1а. Функция вычисления суммы элементов массива А. 1-ый способ. Public Function Сумма_массива(a As Variant) As Double Dim s As Double, x As Variant s = 0 For Each x In a s = s + x Next x Сумма_массива = s End Function
|
'Пример 1б. Функция вычисления суммы элементов массива А. 2-ый способ. Public Function Сумма_массива_2(a As Variant) As Double Dim s As Double, n As Double, m As Double, r As Integer, c As Integer 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 Сумма_массива_2 = s End Function
| 'Пример 2. Функция подсчета количества положительных элементов массива А. Public Function Количество_положительных_элементов(a As Variant) As Double Dim k As Double, n As Double, m As Double, r As Integer, c As Integer 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 Количество_положительных_элементов = k End Function
|
'Пример 3. Нахождение максимального и минимального значения массива А. Public Function Max_Min_A(a As Variant) As String Dim minimal As Variant, maximal As Variant, n As Double, m As Double, r As Integer, c As Integer 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
| ' №1. Нахождение суммы (количества) положительных (отрицательных) элементов массива А. Public Function Сумма_и_количество_положительных_и_отрицательных(a As Variant) As String Dim s As Double, x As Variant, s1 As Double, k As Double, k1 As Double s = 0 s1 = 0 k = 0 k1 = 0 For Each x In a If x > 0 Then s = s + x k = k + 1 Else If x < 0 Then s1 = s1 + x k1 = k1 + 1 End If End If Next x Сумма_и_количество_положительных_и_отрицательных = "Сумма положительных эл-тов: " + Str(s) + "; Сумма отрицательных эл-тов: " + Str(s1) + "; Кол-во положительных эл-тов: " + Str(k) + "; Кол-во отрицательных эл-тов: " + Str(k1) End Function
|
' №2. Нахождение суммы (количества) элементов массива стоящих на четных (нечетных) местах. Public Function Сумма_и_количество_элементов_на_чет_и_нечет_местах(a As Variant) As String Dim k As Double, s As Double, s1 As Double, k1 As Double, n As Double, m As Double, r As Integer, c As Integer n = a.Columns.Count m = a.Rows.Count s = 0 s1 = 0 k = 0 k1 = 0 For r = 1 To m For c = 1 To n If (r + c) Mod 2 = 0 Then s = s + a(r, c) k = k + 1 Else s1 = s1 + a(r, c) k1 = k1 + 1 End If Next c Next r Сумма_и_количество_элементов_на_чет_и_нечет_местах = "Сумма эл-тов на четных местах: " + Str(s) + "; Сумма эл-тов на нечетных местах: " + Str(s1) + "; Кол-во эл-тов на четных местах: " + Str(k) + "; Кол-во эл-тов на нечетных местах: " + Str(k1) End Function
| '№3. Нахождение произведения отрицательных (положительных) элементов массива Public Function Произведение_отрицательных_и_положительных(a As Variant) As String Dim p As Double, p1 As Double, x As Variant p = 1 p1 = 1 For Each x In a If x > 0 Then p = p * x Else If x < 0 Then p1 = p1 * x End If Next x Произведение_отрицательных_и_положительных = "Произведение положительных: " + Str(p) + "; Произведение отрицательных: " + Str(p1) End Function
|
'№4. Подсчет количества отрицательных (положительных, нулевых, кратных k) элементов массива Public Function Количество_положительных_отрицательных_нулевых_и_кратных_k(a As Variant, k As Double) As String Dim c As Double, c1 As Double, c2 As Double, c3 As Double, x As Variant c = 0 c1 = 0 c2 = 0 c3 = 0 For Each x In a If x > 0 Then c = c + 1 Else If x < 0 Then c1 = c1 + 1 Else c2 = c2 + 1 End If End If If x Mod k = 0 Then c3 = c3 + 1 Next x Количество_положительных_отрицательных_нулевых_и_кратных_k = "Количество положительных: " + Str(c) + "; Количество отрицательных: " + Str(c1) + "; Количество нулевых: " + Str(c2) + "; Количество кратных k: " + Str(c3) End Function
' №5. Нахождение суммы четных (нечетных, кратных n) элементов массива Public Function Сумма_чет_нечет_и_кратных_n(a As Variant, n As Double) As String Dim s As Double, s1 As Double, s2 As Double, x As Variant s = 0 s1 = 0 s2 = 0 For Each x In a If x Mod 2 = 0 Then s = s + x Else s1 = s1 + x End If If x Mod n = 0 Then s2 = s2 + x Next x Сумма_чет_нечет_и_кратных_n = "Сумма четных эл-тов: " + Str(s) + "; Сумма нечетных эл-тов: " + Str(s1) + "; Сумма эл-тов кратных k: " + Str(s2) End Function
| 'Нахождение НОК Public Function NOK(a As Variant, b As Variant) As Double Dim c As Variant If a > b Then c = a Else c = b End If Do Until c Mod a = 0 And c Mod b = 0 c = c + 1 Loop NOK = c End Function
'Нахождение НОД Public Function NOD(a As Variant, b As Variant) As Double a = Abs(a) b = Abs(b) While a <> b If a > b Then a = a - b Else b = b - a End If Wend NOD = a End Function
|
6. Нахождение НОД (НОК) элементов массива Public Function НОД_и_НОК_массива(a As Variant) As String Dim n As Variant, m As Variant, r As Variant, c As Variant, n1 As Integer, d As Integer, e As Integer, w, q, f As Double, p, l As Integer m = a.Rows.Count n = a.Columns.Count n1 = 1 For r = 1 To m For c = 1 To n d = n1 If a(r, c) <> 0 Then e = Abs(a(r, c)) n1 = NOK(d, e) End If Next c Next r w = NOD(a(1, 1), a(1, 2)) For p = 1 To m For l = 1 To n If a(p, l) <> 0 Then f = Abs(a(p, l)) q = NOD(f, w) End If Next l Next p НОД_и_НОК_массива = "НОК массива: " + Format(n1) + "; НОД массива: " + Format(q) End Function
| '№ 7. Нахождение минимального (максимального) элемента массива и места его расположения в массиве (номера строки и номера столбца) Public Function Max_Min_и_их_место_расположения(a As Variant) As String Dim min As Variant, max As Variant, n As Double, m As Double, r As Integer, c As Integer, d As Integer, e As Integer, d1 As Integer, e1 As Integer n = a.Columns.Count m = a.Rows.Count min = a(1, 1) max = a(1, 1) For r = 1 To m For c = 1 To n If a(r, c) < min Then min = a(r, c) d = r e = c End If If a(r, c) > max Then max = a(r, c) d1 = r e1 = c End If Next c Next r Max_Min_и_их_место_расположения = "Минимальный эл-т: " + Str(min) + "; Номер минимального (строка, столбец): " + Str(d) + "," + Str(e) + "; максимальный эл-т: " + Str(max) + "; Номер максимального (строка, столбец): " + Str(d1) + "," + Str(e1) End Function
|
'№8. Нахождение максимального среди отрицательных (минимального среди положительных элементов массива) Public Function Max_среди_отрицательных_и_Min_среди_положительных(a As Variant) As String Dim n As Variant, m As Variant, r As Variant, c As Variant, min_p As Double, min As Variant, d As Integer, max_n As Double, max As Variant, e As Integer m = a.Rows.Count n = a.Columns.Count d = 0 e = 0 For r = 1 To m For c = 1 To n If a(r, c) > 0 Then min = a(r, c) d = 1 Exit For End If If a(r, c) < 0 Then max = a(r, c) e = 1 Exit For End If Next c Next r For r = 1 To m For c = 1 To n If a(r, c) > 0 And a(r, c) < min Then min = a(r, c) If a(r, c) < 0 And a(r, c) > max Then max = a(r, c) Next c Next r If d = 0 Then min_p = "нет положительный чисел" Else min_p = min If e = 0 Then max_n = "нет отрицательных чисел" Else max_n = max Max_среди_отрицательных_и_Min_среди_положительных = "Минимальный эл-т среди положительных: " + Str(min_p) + "; Максимальный эл-т среди отрицательных: " + Str(max_n) End Function
| ' №9. Нахождение двух самых больших (самых маленьких) элементов массива. Public Function Два_самых_больших_и_самых_маленьких_элемента(a As Variant) As String Dim max1, max2, min1, min2 As Variant, m, n, i, j As Integer m = a.Rows.Count n = a.Columns.Count max1 = a(1, 1) min1 = a(1, 1) If a(1, 1) < a(1, 2) Then max1 = a(1, 2) max2 = a(1, 1) End If If a(1, 1) > a(1, 2) Then min1 = a(1, 2) min2 = a(1, 1) End If For i = 1 To m For j = 1 To n If a(i, j) >= max1 Then max1 = a(i, j) Else If a(i, j) >= max2 Then max2 = a(i, j) End If End If If a(i, j) <= min1 Then min1 = a(i, j) Else If a(i, j) <= min2 Then min2 = a(i, j) End If End If Next j Next i Два_самых_больших_и_самых_маленьких_элемента = "Два самых больших элемента: " + Str(max1) + " и" + Str(max2) + "; Два самых маленьких элемента: " + Str(min1) + " и " + Str(min2) End Function
|
'№10. Нахождение минимального и максимального элемента массива, выполнив наименьшее число сравнений О(1.5n), где n число элементов в массиве Public Function max_min(a As Variant) Dim q As Integer, w As Integer, av, max, min, n As Integer, m As Integer, s As Double, r As Integer, c As Integer n = a.Columns.Count m = a.Rows.Count av = Сумма_массива_2(a) / (n * m) max = av min = av For r = 1 To m For c = 1 To n If a(r, c) > av Then If a(r, c) > max Then max = a(r, c) End If Else If a(r, c) < min Then min = a(r, c) End If End If Next c Next r max_min = "Максимальный эл-т:" + Str(max) + "; Минимальный эл-т: " + Str(min) End Function
| '№11. Расположить элементы массива в следующем порядке – положительные, отрицательные и нулевые Public Function Расположить_массив(a As Variant) As Variant Dim b(), i As Integer, r, n As Integer, m As Integer, p As Integer, q As Integer, w As Integer n = a.Columns.Count m = a.Rows.Count p = n - 1 ReDim b(p) i = 0 For Each r In a If r > 0 Then b(i) = r i = i + 1 End If Next r For Each r In a If r < 0 Then b(i) = r i = i + 1 End If Next r Расположить_массив = b() End Function
|
'№12a. Упорядочить по возрастанию элементы массива Public Function Упорядочить_массив(a As Variant) As Variant Dim n As Integer, i As Integer, j As Integer, t 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 i For i = 1 To n - 1 For j = i + 1 To n If b(j) < b(i) Then t = b(i) b(i) = b(j) b(j) = t End If Next j Next i Упорядочить_массив = b End Function
| ' №12б. Упорядочить по убыванию элементы массива Public Function Упорядочить_массив_2(a As Variant) As Variant Dim n As Integer, i As Integer, j As Integer, t 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 i For i = 1 To n - 1 For j = i + 1 To n If b(j) > b(i) Then t = b(i) b(i) = b(j) b(j) = t End If Next j Next i Упорядочить_массив_2 = b End Function
|
'№13. В упорядоченном массиве, найти такие два элемента, произведение которых максимально (минимально) Public Function Максимальное_произведение(a As Variant) As Variant Dim b() As Variant, n As Integer, d, c, c1, d1 As Variant n = a.Columns.Count ReDim b(n) b = Упорядочить_массив(a) If b(1) * b(2) > b(n - 1) * b(n) Then d = b(1) c = b(2) Else d = b(n - 1) c = b(n) End If If b(1) * b(n) < 0 Then c1 = b(1) d1 = b(n) Else c1 = b(1) d1 = b(2) End If Максимальное_произведение = "Два элемента, произведение которых максимально: " + Format(d) + " и " + Format(c) + "; Максимальное произведение: " + Format(d * c) + "; Два элемента, произведение которых минимально: " + Format(d1) + " и " + Format(c1) + "; Минимальное произведение: " + Format(d1 * c1) End Function
| ' №14. Из двух упорядоченных по возрастанию массивов, получить третий, упорядоченный по возрастанию Public Function Получение_третьего_массива(a As Variant, b As Variant) As Variant Dim c(), m As Integer, n As Integer, i As Integer, t, p As Integer, j As Integer m = a.Columns.Count n = b.Columns.Count ReDim c(1 To m + n) For i = 1 To m c(i) = a(i) Next i For i = m + 1 To m + n c(i) = b(i - m) Next i p = m + n For i = 1 To p - 1 For j = i + 1 To p If c(j) < c(i) Then t = c(i) c(i) = c(j) c(j) = t End If Next j Next i Получение_третьего_массива = c() End Function
'Функция выясняет, является ли заданное число Простым Public Function Простое_число(ByVal n As Long) As Boolean Dim i As Integer Простое_число = False For i = 2 To Sqr(n) If n Mod i = 0 Then Exit Function End If Next i Простое_число = True End Function
|
'15. Находим ближайшее к А простое число Public Function Задание_15(a As Integer) As String Dim n, n1 As Integer n = a n1 = a While Простое_число(n) <> True And Простое_число(n1) <> True n = n + 1 n1 = n1 - 1 Wend If Abs(n - a) <= Abs(n1 - a) Then Задание_15 = "Ближайшее к А простое число: " + Format(n) Else Задание_15 = "Ближайшее к А простое число: " + Format(n1) End If End Function
| Public Function Сумма_цифр_числа (n As Integer) As Integer 'Функция нахождения суммы цифр целого числа n Dim s As Integer, c As Integer s = 0 While n <> 0 c = n Mod 10 s = s + c n = n / 10 Wend Сумма_цифр_числа = s End Function
|
Public Function НОД_двух (a As Integer, b As Integer) As Integer 'Функция нахождения НОД двух натуральных чисел a и b While a <> b If a > b Then a = a - b Else b = b - a End If Wend НОД_двух = a End Function Public Function Простое_число(a As Integer) As String 'Является a простым числом или нет Dim i As Integer For i = 2 To a - 1 If a Mod i = 0 Then Exit For Next i If i < a - 1 Or a = 0 Or a = 1 Then Простое_число = "Нет" Else Простое_число = "Да" End If End Function
| Public Function Число_в_обратном_порядке (a As Double) As String 'Получение числа, записанного цифрами заданного числа в обратном порядке Dim n As Integer, i As Integer n = Len(Format(a)) Число_в_обратном_порядке = "" For i = n To 1 Step -1 Число_в_обратном_порядке = Число_в_обратном_порядке + Mid(Format(a), i, 1) Next i If a < 0 Then Число_в_обратном_порядке = -Число_в_обратном_порядке(Abs(a)) End If End Function
|
Public Function Сумма_делителей (n As Double) As Double 'Нахождение суммы делителей числа N Dim s As Double, i As Integer, p As Integer s = 1 p = Sqr(n) If p * p = n Then s = s + p p = p - 1 End If For i = 2 To p If n Mod i = 0 Then s = s + i + n \ i End If Next i Сумма_делителей = s End Function
| Public Function Сумма_чисел_Фибоначчи (n As Double) As Double 'Вычисление суммы первых n чисел Фибоначчи Dim s As Double, p As Integer, i As Integer, k As Integer s = 0 p = 1 i = 1 For k = 1 To n s = p + i p = i i = s Next k Сумма_чисел_Фибоначчи = s - 1 End Function
|
Public Function Автоморфное (n As Variant) As String 'Определить, является ли заданное число N автоморфным If n ^ 2 Mod 10 ^ Len(n) = n Then Автоморфное = "Да" Else Автоморфное = "Нет" End If End Function
| Public Function Число_Армстронга( n As Integer) As String 'Определить, является ли заданное число n числом Армстронга Dim s As Integer, p As Integer, c As Integer s = 0 p = n While p <> 0 c = p Mod 10 s = s + c ^ Len(Format(n)) p = p \ 10 Wend If s = n Then Число_Армстронга = "Да" Else Число_Армстронга = "Нет" End If End Function
|
Public Function Полиндром (a As Double) As String 'Определить, является ли заданное число N полиндромом If Format(a) = Число_в_обратном_порядке(a) Then Полиндром = "Да" Else Полиндром = "Нет" End If End Function
| Public Function Все_простые_числа_на_отрезке( n As Integer, m As Integer) As Variant 'На отрезке [n, m] найти все простые числа Dim k As String, i As Integer k = "" For i = n To m If Простое_число(i) = "Да" Then k = k + " " + Format(i) + "," End If Next i Все_простые_числа_на_отрезке = Left(k, Len(k) - 1) End Function
|
Public Function Все _автоморфные_числа_на_отрезке (n As Integer, m As Integer) As Variant 'На отрезке [n, m] найти все автоморфные числа Dim k As String, i As Integer k = "" For i = n To m If Автоморфное(i) = "Да" Then k = k + " " + Format(i) + "," End If Next i Все_автоморфные_числа_на_отрезке = Left(k, Len(k) - 1) End Function
| Public Function Совершенное (n As Double) As String 'Определить, является ли заданное число N совершенным If Сумма_делителей(n) = n Then Совершенное = "Да" Else Совершенное = "Нет" End If End Function
|
Public Function Все_совершенные_числа_на_отрезке (n As Integer, m As Integer) As Variant 'На отрезке [n, m] найти все совершенные числа Dim k As String, i As Double k = "" For i = n To m If Совершенное(i) = "Да" Then k = k + " " + Format(i) + "," End If Next i Все_совершенные_числа_на_отрезке = Left(k, Len(k) - 1) End Function
| Public Function Все_полиндромы_на_отркзке (n As Integer, m As Integer) As Variant 'На отрезке [n, m] найти все полиндромы Dim k As String, i As Double k = "" For i = n To m If Полиндром(i) = "Да" Then k = k + " " + Format(i) + "," End If Next i Все_полиндромы_на_отркзке = Left(k, Len(k) - 1) End Function
|
Public Function Все_числа_Армстронга_на_отрезке (n As Integer, m As Integer) As Variant 'На отрезке [n, m] найти все числа Армстронга Dim i As Integer, k As String k = "" For i = n To m If Число_Армстронга(i) = "Да" Then k = k + " " + Format(i) + "," End If Next i Все_числа_Армстронга_на_отрезке = Left(k, Len(k) - 1) End Function
| Public Function Все_числа_близнецы_на_отрезке (n As Integer, m As Integer) As Variant 'На отрезке [n, m] найти все числа близнецы Dim i As Integer, k As String k = "" For i = n To m If Простое_число(i) = "Да" And Простое_число(i + 2) = "Да" And (i + 2) <= m Then k = k + Format(i) + " " + "и" + " " + Format(i + 2) + "," + " " End If Next i Все_числа_близнецы_на_отрезке = Left(k, Len(k) - 2) End Function
|
Public Function НОД_трех (a As Integer, b As Integer, c As Integer) As Integer 'НОД трех чисел НОД_трех = НОД_двух(НОД_двух(a, b), c) End Function
Public Function НОК_трех(a As Integer, b As Integer, c As Integer) As Integer 'НОК трех чисел НОК_трех = НОК_двух(НОК_двух(a, b), c) End Function
| Public Function НОК_двух (a As Integer, b As Integer) As Integer 'НОК двух чисел Dim c As Integer If a > b Then c = a Else c = b End If Do Until c Mod a = 0 And c Mod b = 0 c = c + 1 Loop НОК_двух = c End Function
|
Public Function FunS(n As Double) As Double 'Функция вычисления суммы S=1^2+2^2+...+n^2 Dim s As Integer Dim i As Integer s = 0 For i = 1 To n s = s + i ^ 2 Next FunS = s End Function
| Public Function sinus(x As Double, погрешность As Double) As Double 'Функция вычисления приближенного значения sin(x) по формуле у=x/1!-x^3/3!+x^5/5!-...+x^(2n+1)/(2n+1)! с заданной погрешностью Dim i As Double Dim p As Double Dim s As Double 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
|
Public Function Fun1(n As Double) As Double 'Функция вычисления суммы S=1/1+1/2+...+1/n, где n заданное число Dim s As Double Dim i As Integer s = 0 For i = 1 To n s = s + (1 / i) Next Fun1 = s End Function
| Public Function Fun2(m As Double, n As Double) As Double ' Функция вычисления суммы S=2*m+...+2*n,где m и n заданные числа Dim s As Double Dim i As Double s = 0 For i = m To n s = s + 2 * i Next Fun2 = s End Function
| |||||
Public Function Fun3(n As Double) As Double 'Вычисления суммы S=10^3+11^3+…+n^3 Dim s As Double Dim i As Double s = 0 For i = 10 To n s = s + i ^ 3 Next Fun3 = s End Function
| Public Function Fun4(m As Double, n As Double) As Double 'Найти P=2*m*...*2*n, где m и n заданные числа Dim p As Double Dim i As Double p = 1 For i = m To n p = p * 2 * i Next Fun4 = p End Function
| |||||
Public Function Fun9(n As Double) As Double 'Найти s=f(1)+f(2)+...+f(n), где f(i) любая заданная функция Dim s As Double Dim i As Double Dim f As Double s = 0 For i = 1 To n f = 2 * i + 1 / i s = s + f Next Fun9 = s End Function
| Public Function Fun10(n As Double) As Double 'Найти P=f(1)*f(2)*...*f(n), где n заданное число и f(i) любая заданная функция Dim p As Double Dim i As Double Dim f As Double p = 1 For i = 1 To n f = (1 / 2) * i p = p * f Next Fun10 = p End Function
| |||||
Public Function Fun11(n As Double) As Double 'Вычисления произведения P=n!=1*2*...*n Dim p As Double Dim i As Double p = 1 For i = 1 To n p = p * i Next Fun11 = p End Function
| Public Function Fun5() As Double 'Вычислить сумму кубов трехзначных четных чисел Dim s As Double Dim i As Double s = 0 For i = 100 To 998 Step 2 s = s + i ^ 3 Next Fun5 = s End Function
| |||||
Public Function Fun6() As Double 'Вычислить сумму квадратов тех четырехзначных чисел, которые при делении на 5 дают в остатке 2 Dim s As Double Dim i As Double s = 0 For i = 1002 To 9997 Step 5 s = s + i ^ 2 Next Fun6 = s End Function
| Public Function Fun8() As Double 'Найти сумму S=1*100+2*99+3*98+…+ 50 *51 Dim s As Double Dim i As Double s = 0 i = 1 While i <= 50 s = s + i * (101 - i) i = i + 1 Wend Fun8 = s End Function
| |||||
Public Function Fun12(m As Double) As Double 'Нахождения такой суммы S=1+2+3+..., для которой |S-M| минимально. M –заданное число Dim s As Double Dim i As Double i = 0 s = 0 If m < 0 Then Fun12 = 1 Else While s + i <= m s = s + i i = i + 1 Wend If m - s < (s + i) - m Then Fun12 = s Else Fun12 = s + i End If End If
End Function
| Public Function Fun13(n As Double) As Double 'Вычисления суммы S= 1!+2!+3!+……+ n! Dim i As Double Dim s As Double s = 0 For i = 1 To n s = s + Fun11(i) Next Fun13 = s End Function
| |||||
Public Function Fun14(x As Double, n As Double) As Double 'Вычисления приближенного значения cos(x) по формуле у=1-x^2/2!+x^4/4!-….+x^2n/(2n)! для заданного числа n 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
| 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
| |||||
Public Function Fun7(m As Integer, n As Integer, k As Integer) As String 'Суммa всех несократимых дробей, со знаменателем k, содержащихся между целыми числами m и n, где k простое число Dim s As Double, i As Integer, g As Double If Простое_число(k) = "Нет" Then Fun7 = "знаменатель не является простым числом" Exit Function Else s = 0 For i = m To n If i Mod k <> 0 Then s = s + i / k End If Next i End If Fun7 = s End Function
| Public Function Fun15(x As Double, e As Double) As Double 'Функция вычисления приближенного значения e^x по формуле y=1+x/1!+x^2/2!+...+x^n/n!, с заданной точностью E Dim i As Integer Dim s As Double Dim p As Double Dim s1 As Double s = 1 + x p = x i = 1 s1 = 0 While Abs(s - s1) >= e p = p * x / (i + 1) s1 = s i = i + 1 s = s + p Wend Fun15 = s End Function
| |||||
Public Function fun1(x As Double) As Variant 'функция вычисления выражения (x ^ 2 - 5 * 2 ^ (1/2)) / (2*x^3 + 1) Dim d As Double d = 2 * x ^ 3 + 1 If d = 0 Then fun1 = " нет решений " Else fun1 = (x ^ 2 - 5 * 2 ^ (1 / 2)) / d End If
End Function
| Public Function Полупериметр(a As Double, b As Double, c As Double) As Variant ' функция вычисления полупериметра треугольника по трем сторонам a, b, c If a + b < c Or a + c < b Or b + c < a Or a = 0 Or b = 0 Or c = 0 Then Полупериметр = " треугольник не существует" Else Полупериметр = (a + b + c) / 2 End If End Function
| |||||
Public Function Окружность(R As Double) As String 'функция вычисления длины окружности и площади круга заданного радиуса R Const pi As Integer = 3.14 Dim a As Double Dim b As Double Дата добавления: 2015-11-04; просмотров: 47 | Нарушение авторских прав
|