Sub Kol_i_summ_otrec() Dim a() As Double, i As Integer, n As Integer, kol As Integer, summ As Double
' забиваем массив n = inputbox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = inputbox("Введите " + CStr(i) + "-ый элемент") Cells(4, 1 + i) = a(i) Next i
' ищем отрецательные и складываем kol = 0 summ = 0 For i = 1 To n If a(i) < 0 Then kol = kol + 1 summ = summ + a(i) End If Next i
' выводим на лист Cells(6, 2) = "Количество отрецательных элементов: " + CStr(kol) Cells(7, 2) = "Сумма отрецательных элементов: " + CStr(summ) End Sub
Sub Kol_polog() Dim a() As Double, i As Integer, n As Integer, kol As Integer
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-ый элемент") Cells(4, 1 + i) = a(i) Next i
' ищем положительные kol = 0 For i = 1 To n If a(i) < 0 Then kol = kol + 1 End If Next i
' выводим на лист Cells(6, 2) = "Количество положительных элементов: " + CStr(kol) End Sub
Sub iskl_nul() Dim a() As Double, i As Integer, n As Integer, c() As Double, kolp As Integer, j As Integer
Cells.Clear Cells(1, 6) = "В числовой последовательности могут быть как положительные, так и отрецательные и нулевые значения. Необходимо из этой последовательности исключить нулевые значения"
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-ый элемент") Cells(4, 1 + i) = a(i) Next i
' узнаем количество ненулевых переменных kolp = 0 For i = 1 To n If a(i) <> 0 Then kolp = kolp + 1 End If Next i ReDim c(1 To kolp)
' записывваем только ненулевые элементы j = 1 For i = 1 To n If a(i) <> 0 Then c(j) = a(i) j = j + 1 End If Next i
' выврдми на экран For i = 1 To kolp Cells(6, i + 1) = c(i) Next i End Sub
Sub chet_v_k_nechet_na_c() Dim n As Integer, a() As Double, i As Integer, k As Double, c As Double
Cells.Clear Cells(1, 6) = "Дана числовая последовательность, состоящая из N значений. Требуется значения с четными номерами увеличить в k раз, а значения с нечетными - на величину С."
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i k = InputBox("Во сколько раз увеличить значения под четными номерами?") c = InputBox("На сколько увеличить значения под нечетными номерами?")
' проверяем на четность-нечетность и увеличиваем значения For i = 1 To n If i Mod 2 = 0 Then a(i) = a(i) * k Else a(i) = a(i) + c End If Next i
' выводим на экран For i = 1 To n Cells(6, i + 1) = a(i) Next i End Sub
|
Sub vektory_a_i_b() Dim a() As Double, b() As Double, i As Integer, j As Integer, c() As Double
Cells.Clear
' забиваем массив a n = InputBox("Введите число элементов массивов a и b:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
ReDim c(1 To n)
' забиваем массив b ReDim b(1 To n) For i = 1 To n b(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(5, 1 + i) = b(i) Next i
c = a
' складываем элементы массива j = 0 For i = n To 1 Step -1 j = j + 1 c(j) = c(j) + b(i) Next i
' выврдми на экран For i = 1 To n Cells(7, i + 1) = c(i) Next i End Sub
Sub kol_po_granicam() Dim n As Integer, a() As Double, i As Integer, b As Double, с As Double, kol As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i b = InputBox("Введите левую границу: b = ") c = InputBox("Введите правую границу: c = ")
' проверяем на условиеи b<=a(i)<=c kol = 0 For i = 1 To n If (a(i) >= b) And (a(i) <= c) Then kol = kol + 1 End If Next i
' выводим на лист Cells(6, 2) = kol
End Sub
Sub posled_iz_nomerov_pologh() Dim n As Integer, a() As Double, i As Integer, b() As Double, kolp As Integer, о As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' узнаем количество положительных kolp = 0 For i = 1 To n If a(i) > 0 Then kolp = kolp + 1 End If Next i
ReDim b(1 To kolp)
' переносим номера положительных в массив j = 0 For i = 1 To n If a(i) >= 0 Then j = j + 1 b(j) = i End If Next i
' выводим на экран For i = 1 To kolp Cells(6, 1 + i) = b(i) Next i End Sub
Sub perv_otrec() Dim n As Integer, a() As Double, i As Integer, k As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' проверяем элементы на отрецательность k = 0 For i = 1 To n If a(i) < 0 Then k = i Exit For End If Next i
' выводим сообщение, если отрецательных элементов нет, и выводим номер отрецательного элемент на экран, если он есть If k = 0 Then MsgBox ("Нет отрец. элементов") Else Cells(6, 2) = k End If
End Sub
| Sub obratniy_poryadok() Dim n As Integer, a() As Double, i As Integer, b() As Double, j As Integer
Cells.Clear ' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) ReDim b(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' переворячеваем массив j = 0 For i = n To 1 Step -1 j = j + 1 b(j) = a(i) Next i
' выводим на экран For i = 1 To n Cells(6, 1 + i) = b(i) Next i
End Sub
Sub funct_one() Dim nx As Integer, x() As Double, i As Integer, z() As Double, nz As Integer, j As Integer, y As Double, k As Integer
Cells.Clear
' забиваем массив x nx = InputBox("Введите число элементов:") ReDim x(1 To nx) For i = 1 To nx x(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = x(i) Next i
' забиваем массив z nz = InputBox("Введите число элементов:") ReDim z(1 To nz) For i = 1 To nz z(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(5, 1 + i) = z(i) Next i
' высчитываем значения функции, перебирая все комбинации k = 0 For i = 1 To nx For j = 1 To nz k = k + 1 y = 2 * x(i) * x(i) + Sin(z(j)) Cells(6 + k, 2) = y Next j Next i
End Sub
Sub odinakov_chisla() Dim n As Integer, a() As Double, i As Integer, j As Integer, k As Double, title As String, u As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' проверяем элементы на одинаковость, последовательно сопоставляя их For i = 2 To n k = a(i) If u <> 1 Then For j = 1 To n If (k = a(j)) And (j <> i) Then title = "совпадение " + CStr(i) + " и " + CStr(j) + " элементов! Это число " + CStr(k) u = 1 Exit For Else title = "нет совпадений" End If Next j End If Next i
' выводим на экран Cells(6, 2) = title End Sub
Sub lomannaya() Dim n As Integer, x() As Double, y() As Double, i As Integer, a() As Double, b() As Double, z() As Double, j As Integer, leng As Double
Cells.Clear
' забиваем массив координаты х n = InputBox("Введите число элементов:") ReDim x(1 To n) ReDim y(1 To n) ReDim a(1 To n - 1) ReDim b(1 To n - 1) ReDim z(1 To n - 1) For i = 1 To n x(i) = InputBox("Введите " + CStr(i) + "-ую координату Х") Cells(4, 1 + i) = x(i) Next i
' забиваем массив координаты у For i = 1 To n y(i) = InputBox("Введите " + CStr(i) + "-ую координату Y") Cells(5, 1 + i) = y(i) Next i ' считаем длины сторон треугольников j = 0 For i = n To 2 Step -1 j = j + 1 a(j) = x(i) - x(i - 1) b(j) = y(i) - y(i - 1) Next i
' считаем длина отрезков ломанной For i = 1 To n - 1 z(i) = Sqr(a(i) ^ 2 + b(i) ^ 2) Next i
' складываем длины отрезков ломанной leng = 0 For i = 1 To n - 1 leng = leng + z(i) Next i ' вывод Cells(7, 2) = leng
End Sub |
Sub min_otklon_ot_Sred_znach() Dim n As Integer, a() As Double, i As Integer, summ As Double, sred As Double, minotkl As Double, nom As Integer, el As Double
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' находим среднее значение summ = 0 For i = 1 To n summ = summ + a(i) Next i sred = summ / n
' проверяем элементы на отклонение minotkl = sred - a(1) For i = 2 To n If Abs((sred - a(i))) < minotkl Then minotkl = sred - a(i) nom = i el = a(i) End If Next i
' вывод на лист Cells(6, 2) = "Среднее значение " + CStr(sred) Cells(8, 2) = "Наименьшее отклонение от среднего значения имеет элемент " + CStr(el) + " под номером " + CStr(nom)
End Sub
Sub sam_dlin_kor_i_sred_slova() Dim n As Integer, a() As String, i As Integer, min As Integer, max As Integer, sred As Double, summ As Double, sredstr As String, minstr As String, dl As Double Dim maxstr As String, j As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' ищем самое длинное слово и возвращаем его длину max = 0 For i = 1 To n If Len(a(i)) > max Then max = Len(a(i)) maxstr = a(i) End If Next i
' ищем самое короткое слово и возвращаем его длину min = 999 For i = 1 To n If Len(a(i)) < min Then min = Len(a(i)) minstr = a(i) End If Next i
' находим среднюю длину summ = 0 For i = 1 To n summ = summ + Len(a(i)) Next i sred = summ / n 'sred = Fix(sred)
' проверяем элементы на отклонение dl = 999 For i = 1 To n If Abs(Len(a(i)) - sred) < dl Then dl = Abs(Len(a(i)) - sred) sredstr = a(i) End If Next i
' вывод на лист Cells(6, 2) = "Макс.длина: " + maxstr Cells(7, 2) = "Мин.длина: " + minstr Cells(8, 2) = "Сред. по длине: " + sredstr
End Sub
Sub vpis_i_opis_okr() Dim n As Integer, a(1 To 10, 1 To 3) As Double, i As Integer, k As Integer, p As Double, ro(1 To 10) As Double, rb(1 To 10) As Double Dim storoni(1 To 3) As Double, s As Integer
Cells.Clear
' забиваем массив For i = 1 To 10 For k = 1 To 3 a(i, k) = InputBox("Введите число") Cells(1 + i, 2 + k) = a(i, k) Next k Next i
' создаем массив сторон одного треугольника For k = 1 To 10 For i = 1 To 3 storoni(i) = a(k, i) Next i p = (storoni(1) + storoni(2) + storoni(3)) / 2 ' считаем радиусы окружностей rb(k) = Sqr(((p - storoni(1)) * (p - storoni(2)) * (p - storoni(3))) / p) ro(k) = storoni(1) * storoni(2) * storoni(3) / 4 * Sqr((p - storoni(1)) * (p - storoni(2)) * (p - storoni(3)) * p) Next k
' вывод на лист Cells(5, 8) = "Радиус вписанной окр." Cells(7, 8) = "Радиус описанной окр." For i = 1 To 10 Cells(6, 8 + i) = rb(i) Cells(8, 8 + i) = ro(i) Next i
End Sub
|
Sub procent() Dim n As Integer, a() As Double, i As Integer, k As Integer, b() As Double, kol As Integer, summ As Double, sred As Double
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' находим среднее значение summ = 0 For i = 1 To n summ = summ + a(i) Next i sred = summ / n Cells(5, 2) = "Сред. знач. = " + CStr(sred)
' ищем кол-во подходящих элементов kol = 0 For i = 1 To n If ((sred / 2) <= a(i)) And (a(i) <= (sred * 1.5)) Then kol = kol + 1 End If Next i
ReDim b(1 To kol)
' создаем массив из подходящих элементов k = 0 For i = 1 To n If ((sred / 2) <= a(i)) And (a(i) <= (sred * 1.5)) Then k = k + 1 b(k) = a(i) End If Next i
' вывод на лист For i = 1 To kol Cells(6, 1 + i) = b(i) Next i
End Sub
Sub kol_pol_i_summa_otrec() Dim n As Integer, a() As Double, i As Integer, summotr As Double, kolpol As Double
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' ищем сумму отрец. значений summotr = 0 For i = 1 To n If a(i) < 0 Then summotr = summotr + a(i) End If Next i
' ищем кол-во положительных значений kolpol = 0 For i = 1 To n If a(i) > 0 Then kolpol = kolpol + 1 End If Next i
' вывод нат экран Cells(6, 2) = "кол-во полож. элементов = " + CStr(kolpol) Cells(8, 2) = "сумма отрец. элементов = " + CStr(summotr)
End Sub
Sub dve_stroki() Dim a() As Double, i As Integer, k As Integer, n As Integer, buf As Double
Cells.Clear
n = InputBox("Введите коло-во элементов") ReDim a(1 To 2, 1 To n)
' забиваем массив For i = 1 To 2 For k = 1 To n a(i, k) = InputBox("Введите число") Cells(1 + i, 1 + k) = a(i, k) Next k Next i
' проверяем элементы на их величину и, если надо, меняем их местами For k = 1 To n If a(1, k) < a(2, k) Then buf = a(1, k) a(1, k) = a(2, k) a(2, k) = buf End If Next k
' вывод на лист For i = 1 To 2 For k = 1 To n Cells(6 + i, 2 + k) = a(i, k) Next k Next i
End Sub
|
Sub srednekvadr_otklonenie() Dim n As Integer, a() As Double, asred As Double, s As Double, summ As Double
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' ищем среднее значение элементов массива а asred = 0 For i = 1 To n asred = (asred + a(i)) / n Next i
' находим сумму (a(i)-asred)^2 summ = 0 For i = 1 To n summ = summ + (a(i) - asred) ^ 2 Next i
' высчитываем среднеквадрптичное отклонение s = Sqr(summ / (n - 1))
' вывод на лист Cells(6, 2) = s
End Sub
Sub chego_bolshe() Dim n As Integer, a() As Double, i As Integer, p As Integer, ot As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' ищем кол-во отрец. значений ot = 0 For i = 1 To n If a(i) < 0 Then ot = ot + 1 End If Next i
' ищем кол-во полож. значений p = 0 For i = 1 To n If a(i) > 0 Then p = p + 1 End If Next i
' вывод на лист Cells(6, 2) = "Отрец. элементов: " + CStr(ot) Cells(7, 2) = "Полож. элементов: " + CStr(p)
' ищем каких значений больше и выводим рез-ты на лист If p > ot Then Cells(9, 2) = "Полож. > отрец." Else Cells(9, 2) = "Полож. < отрец." End If If p = ot Then Cells(9, 2) = "Полож. = отрец." End If End Sub
Sub posled_iz_pologh() Dim n As Integer, a() As Double, i As Integer, b() As Double, kolp As Integer, j As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' ищем кол-во полож. знач kolp = 0 For i = 1 To n If a(i) > 0 Then kolp = kolp + 1 End If Next i
ReDim b(1 To kolp)
' переносим в гновый массив полож. значения For i = 1 To n If a(i) > 0 Then j = j + 1 b(j) = a(i) End If Next i
' вывод на лист For i = 1 To kolp Cells(6, 1 + i) = b(i) Next i End Sub
|
Sub kol_bol_i_men_ot_sred_znach() Dim n As Integer, a() As Double, i As Integer, summ As Double, sred As Double, bol As Integer, men As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' считаем сред. значение summ = 0 For i = 1 To n summ = summ + a(i) Next i sred = summ / n
' ищем сколько каких элементов bol = 0 men = 0 For i = 1 To n If a(i) > sred Then bol = bol + 1 End If If a(i) < sred Then men = men + 1 End If Next i
' вывод на лист Cells(6, 2) = "Сред. знач. = " + CStr(sred) Cells(7, 2) = "Кол-во элементов, меньше сред. знач. = " + CStr(men) Cells(8, 2) = "Кол-во элементов, больше сред. знач. = " + CStr(bol)
End Sub
Sub uvel_na_element() Dim n As Integer, a() As Double, i As Integer, k As Integer, b() As Double
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) ReDim b(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' увеличиваем на значение k k = InputBox("На величену какого элемента (по счету) увеличить?") If (k > n) Or (k < 1) Then k = InputBox("Введено недопустимое значение. Введите верное (от 1 до " + CStr(n) + ")") End If For i = 1 To n b(i) = a(i) + a(k) Next i
' вывод на лист For i = 1 To n Cells(6, 1 + i) = b(i) Next i
End Sub
Sub iskl_bol_sred() Dim a() As Double, i As Integer, k As Integer, n As Integer, summ As Double, sred As Double, buf As Double, kol As Integer, b() As Double
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите число") Cells(2, 2 + i) = a(i) Next i
' считаем сред. знач summ = 0 For i = 1 To n summ = summ + a(i) Next i sred = summ / n
' ищем кол-во элементов, не превышающих сред. значение kol = 0 For i = 1 To n If a(i) <= sred Then kol = kol + 1 End If Next i
ReDim b(1 To kol)
' переносим элементы в новый массив k = 0 For i = 1 To n If a(i) <= sred Then k = k + 1 b(k) = a(i) End If Next i
' вывод на лист Cells(5, 3) = "Сред.знач. = " + CStr(sred) For i = 1 To kol Cells(6, 1 + i) = b(i) Next i
End Sub
| Sub sred_otrec_znach() Dim n As Integer, a() As Double, i As Integer, summotr As Double, sredotr As Double, kolotr As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' ищем отрец. значения и, если они есть, находим из сред. знач summotr = 0 kolotr = 0 For i = 1 To n If a(i) < 0 Then summotr = summotr + a(i) kolotr = kolotr + 1 End If Next i sredotr = summotr / kolotr
If sredotr <> 0 Then Cells(6, 2) = "Сред. арифм. отрец. знач. = " + CStr(sredotr) Else Cells(6, 2) = "отрец. значения отсутствуют" End If
End Sub
Sub umen_massiv() Dim a() As Double, b() As Double, i As Integer, kol As Integer, n As Integer, min As Double, j As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите число") Cells(2, 2 + i) = a(i) Next i
' ищем кол-во ненулевх значений kol = 0 For i = 1 To n If a(i) <> 0 Then kol = kol + 1 End If Next i
' переносим ненулевые значения в новый массив ReDim b(1 To kol)
j = 1 For i = 1 To n If a(i) <> 0 Then b(j) = a(i) j = j + 1 End If Next i
' ищем мин. значение min = b(1) For i = 1 To kol If min > b(i) Then min = b(i) End If Next i
' отнимаем от элементов нового массива мин. значение For i = 1 To kol b(i) = b(i) - min Next i
' вывод на лист For i = 1 To kol Cells(4, 2 + i) = b(i) Next i
End Sub
Sub umen_massiv() Dim a() As Double, b() As Double, i As Integer, kol As Integer, n As Integer, min As Double, j As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите число") Cells(2, 2 + i) = a(i) Next i
' ищем кол-во ненулевх значений kol = 0 For i = 1 To n If a(i) <> 0 Then kol = kol + 1 End If Next i
' переносим ненулевые значения в новый массив ReDim b(1 To kol)
j = 1 For i = 1 To n If a(i) <> 0 Then b(j) = a(i) j = j + 1 End If Next i
' ищем мин. значение min = b(1) For i = 1 To kol If min > b(i) Then min = b(i) End If Next i
' отнимаем от элементов нового массива мин. значение For i = 1 To kol b(i) = b(i) - min Next i
' вывод на лист For i = 1 To kol Cells(4, 2 + i) = b(i) Next i
End Sub
| Sub pol_v_otr() Dim n As Integer, a() As Double, i As Integer, k As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' ищем полож. элементы и меняем их знак For i = 1 To n If a(i) > 0 Then a(i) = 0 - a(i) End If Next i
' вывод на лист For i = 1 To n Cells(6, 1 + i) = a(i) Next i
End Sub
Sub posled_iz_otrec() Dim n As Integer, a() As Double, i As Integer, b() As Double, kolot As Integer, j As Integer
Cells.Clear
' забиваем массив n = InputBox("Введите число элементов:") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите " + CStr(i) + "-й элемент") Cells(4, 1 + i) = a(i) Next i
' ищем кол-во отрец. значений kolot = 0 For i = 1 To n If a(i) < 0 Then kolot = kolot + 1 End If Next i
ReDim b(1 To kolot)
' переносим в новый массив отрец. значения For i = 1 To n If a(i) < 0 Then j = j + 1 b(j) = a(i) End If Next i
' вывод на лист For i = 1 To kolot Cells(6, 1 + i) = b(i) Next i End Sub
'!!!!!!!!!!!!!!!! ВНИМАНИЕ. ЭТО ТОЧНАЯ КОПИЯ ЗАДАЧИ 28!!!!!!!!!!!!!!!!!!!!!!!! Sub iskl_pol() Dim a() As Double, b() As Double, i As Integer, k As Integer, n As Integer, kol As Integer
Cells.Clear
n = InputBox("Введите число элементов") ReDim a(1 To n) For i = 1 To n a(i) = InputBox("Введите число") Cells(2, 2 + i) = a(i) Next i
kol = 0 For i = 1 To n If a(i) < 0 Then kol = kol + 1 End If Next i
ReDim b(1 To kol)
k = 1 For i = 1 To n If a(i) < 0 Then b(k) = a(i) k = k + 1 End If Next i
For i = 1 To kol Cells(4, 2 + i) = b(i) Next i
End Sub
Sub znach_funkcii() Dim n As Double, b As Double, xx() As Double, i As Integer, y As Double, к As Integer, a As Double, x As Double
Cells.Clear
' вводим атрибуты табулирования a = InputBox("Введите левую границу х:") b = InputBox("Введите правую границу х:") h = 1 n = (b - a) / h
' табулируем Cells(1, 1) = "X" Cells(1, 2) = "Y" i = 1 For x = a To b + h / 2 Step h i = i + 1 Cells(i, 1) = x ' считаем у, если 5<=х<=11 If (x >= 5) And (x <= 11) Then Cells(i, 2) = (12 - x) * x * x End If ' считаем у, если 11<x<=17 If (x > 11) And (x <= 17) Then Cells(i, 2) = x * (Sqr(Abs(121 - x ^ 2))) End If Next x
End Sub
|
Sub min_i_max_funrcii() Dim n As Double, aa() As Double, i As Integer, k As Integer, a As Double, b As Double, h As Double, x As Double, min As Double, max As Double
Cells.Clear
' вводим атрибуты табулирования a = 0.1 b = 5.1 h = 0.05 n = (b - a) / h
Cells(1, 1) = "X" Cells(1, 2) = "Y"
ReDim aa(1 To n + 1)
' табулируем, одновременно занося значения у в отдельный массив i = 0 For x = a To b + h / 2 Step h i = i + 1 Cells(i + 1, 1) = x Cells(i + 1, 2) = (x ^ 3 * Exp(0.1 - x)) * Sin(2 * x) + 3 aa(i) = (x ^ 3 * Exp(0.1 - x)) * Sin(2 * x) + 3
Next x
' ищем мин. и макс. значения в массиве min = aa(1) max = aa(1) For i = 1 To n If aa(i) < min Then min = aa(i) End If If aa(i) > max Then max = aa(i) End If Next i
' вывод на лист Cells(5, 4) = "Макс. знач. фун-ии = " + CStr(max) Cells(6, 4) = "Мин. знач. фун-ии =" + CStr(min)
End Sub |
' формула функции Function f(x As Double) If x > 0 Then f = (Sin(x)) * (Sin(x)) - Log(x) End If End Function ' а вот и метод дихотомии;)! ищем корень Function koren(a As Double, b As Double) Dim c As Double
Do While (b - a) > 0.0001 c = (a + b) / 2 If f(a) * f(c) < 0 Then b = c Else a = c End If Loop koren = c
End Function
Sub dihotonia() Dim x As Double, a As Double, b As Double, h As Double, n As Double, a1 As Double, b1 As Double
Cells.Clear ' вводим атрибуты табулирования a = 0 b = 3.14159265358979 n = InputBox("Введите число шагов") h = (a + b) / n
' табулируем Cells(1, 1) = " X" Cells(1, 2) = " Y" Cells(1, 3) = " Корень"
i = 1 For x = a To b + h / 2 Step h i = i + 1 Cells(i, 1) = x Cells(i, 2) = f(x) ' выводим корень If x < b - h / 2 And f(x) * f(x + h) < 0 Then a1 = h b1 = x + h Cells(i, 3) = koren(a1, b1) End If
Next x
End Sub
|
|
Дата добавления: 2015-08-29; просмотров: 28 | Нарушение авторских прав
| <== предыдущая лекция | | | следующая лекция ==> |
| Шмидт Тамара - Крайон. Послания счастья для каждого знака зодиака 11 страница | | | Эпюра распространения загрязнения (взвесь) |