Разработать функцию пользователя, вычисляющую сумму положительных чисел, из трех заданных. (1 балл)




Скачать 92.69 Kb.
Дата04.08.2016
Размер92.69 Kb.







  1. Разработать функцию пользователя, вычисляющую сумму положительных чисел, из трех заданных. (1 балл)

Public Function Fun1(a, b, c)

s = a + b + c

If a < 0 Then

s = s - a

End If


If b < 0 Then

s = s - b

End If

If c < 0 Then



s = s - c

End If


Fun1 = s

End Function



2а Разработать функцию пользователя, вычисляющую сумму четных чисел, из трех заданных. (1 балл)
Public Function Fun_1(a, b, c)

s = a + b + c

If a Mod 2 <> 0 Then

s = s - a

End If

If b Mod 2 <> 0 Then



s = s - b

End If


If c Mod 2 <> 0 Then

s = s - c

End If

Fun_1 = s



End Function

2b Разработать функцию пользователя, 2с Разработать функцию пользователя,

вычисляющую количество четных вычисляющую сумму всех трехзначных

чисел, из трех заданных. (1 балл) чисел, которые при делении на 14, дают

в остатке 8(1 балл)



Public Function fun_1(a, b, c)
Dim s As Byte
s = 0
If a Mod 2 = 0 Then s = s + 1
If b Mod 2 = 0 Then s = s + 1
If c Mod 2 = 0 Then s = s + 1
fun_1 = s
End Function
Public Function fun_2()
Dim n As Integer
Dim m As Integer
m = 999
For n = 100 To m
If n Mod 14 = 8 Then s = s + n
Next n
fun_2 = s
End Function




  1. Разработать функцию пользователя, вычисляющую сумму:

2*78+4*76+6*74...+40*40 (1 балл)


1 способ

Public Function Fun2() As Double

'2*78+4*76+6*74...+40*40

Dim i As Double

Dim s As Double

s = 0


For i = 78 To 40 Step -2

s = s + (i * (80 - i))

Next

Fun2 = s


End Function

2 способ


Public Function Fun_2() As Double

Dim i As Double

Dim s As Double

s = 0


i = 2

While i <= 40

s = s + (i * (80 - i))

i = i + 2

Wend

Fun_2 = s End Function




3a Разработать функцию пользователя, вычисляющую произведение нечетных, меньших чем 300, элементов массива (1балл)

Public Function fun_3(a As Variant)


n = a.Columns.Count
m = a.Rows.Count
p = 1
k = 0
For r = 1 To m
For c = 1 To n
If a(r, c) Mod 2 <> 0 And a(r, c) < 300 Then k = k + 1
Next c
Next r
If k = 0 Then
fun_3 = 0
Else
For r = 1 To m
For c = 1 To n
If a(r, c) Mod 2 <> 0 And a(r, c) < 300 Then p = p * a(r, c)
Next c
Next r
fun_3 = p
End If
End Function



  1. Разработать функцию пользователя, вычисляющую сумму четных цифр числа. (1балл)

Public Function Fun3(ByVal n As Variant) As Variant

Dim c As Double

s = 0


While n <> 0

c = n Mod 10

If c Mod 2 = 0 Then s = s + c

n = n \ 10

Wend

Fun3 = s


End Function


  1. Разработать функцию пользователя, вычисляющую произведение, отрицательных элементов массива (1 балл)




1 способ

Public Function Fun4(a)

n = a.Columns.Count

m = a.Rows.Count

pr = 1

For i = 1 To m



For j = 1 To n

If a(i, j) < 0 Then

pr = pr * a(i, j)

End If


Next j

Next i


Fun4 = pr End Function
2 способ

Public Function Fun_4(a As Variant) As Integer

Dim x As Object, p As Single

p = 1


For Each x In a

If x < 0 Then

p = p * x

End If


Next

Fun_4 = p End Function






  1. Разработать функцию пользователя, вычисляющую количество четных, положительных элементов массива (1 балл)




1 способ

Public Function Fun5(a As Variant) As Integer

Dim x As Object, p As Single

p = 0


For Each x In a

If x > 0 And x Mod 2 = 0 Then

p = p + 1

End If


Next

Fun5 = p


End Function

2 способ


Public Function Fun_5(a)

n = a.Columns.Count

m = a.Rows.Count

s = 0


For i = 1 To m

For j = 1 To n

If a(i, j) Mod 2 = 0 And a(i, j) > 0 Then

s = s + 1

End If

Next j


Next i

Fun_5 = s

End Function





  1. На отрезке [n, m] найти все простые чисел, заканчивающиеся цифрой К. Для ввода исходных данных и вывода результатов, должна быть разработана пользовательская форма. (3 балла)




Private Sub CommandButton1_Click()

a = Val(TextBox1.Value)

b = Val(TextBox2.Value)

c = Val(TextBox3.Value)

For i = a To b

If Prostoe(i) Then

If i Mod 10 = c Then

ListBox1.AddItem (i)

End If

End If


Next i

End Sub
Private Sub CommandButton2_Click()

Form.Hide End Sub

Алгоритм определения простого числа

Public Function Prostoe(a) As Boolean

a = Abs(a)

If a Mod 2 = 0 And a <> 2 Or a = 1 Or a = 0 Then

Prostoe = False

Else

i = 3


koren = Sqr(a)

While i <= koren And a Mod i <> o

i = i + 2

Wend


If i > koren Then Prostoe = True Else Prostoe = False

End If End Function



'Показывает форму из 7 задания

Public Function Форма()

Form.Show

End Function





  1. Составить макрокоманду, которая в выделенном диапазоне рабочей таблицы, переставит максимальный и минимальный элементы (2 балла)

Sub Zamena()

a = Application.Selection

n = UBound(a, 1)

m = UBound(a, 2)

Mini = a(1, 1)

Maxi = a(1, 1)

imin = 1: jmin = 1

imax = 1: jmax = 1

For i = 1 To n

For j = 1 To m

If Mini < a(i, j) Then Mini = a(i, j): imin = i: jmin = j

If Maxi > a(i, j) Then Maxi = a(i, j): imax = i: jmax = j

Next j


Next i

rez = a(imin, jmin)

a(imin, jmin) = a(imax, jmax)

a(imax, jmax) = rez

Application.Selection = a

End Sub



'Функция нахождения суммы цифр целого числа n

Public Function Сумма_цифр_числа(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

'Функция нахождения НОД двух натуральных чисел 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


'Нахождение НОД для 3 чисел a, b, c

Dim k As Integer

k = НОД1(a, b)

While k <> c

If k > c Then

k = k - c

Else

c = c - k



End If

Wend


НОД2 = k

End Function


Public Function НОК_трех(a As Integer, b As Integer, c As Integer) As Integer

НОК_трех = НОК_двух(НОК_двух(a, b), c)


'НОК двух чисел

Public Function НОК2(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

НОК2 = c


End Function

End Function

'Является a простым числом или нет

Public Function Простое(a As Integer) As String

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


'На отрезке [n, m] найти все простые числа

Public Function Vse_prost(n As Integer, m As Integer) As Variant

Dim k As String, i As Integer

k = ""


For i = n To m

If Простое (i) = "Да" Then

k = k + " " + Format(i) + ","

End If


Next i

Vse_prost = Left(k, Len(k) - 1)

End Function
'Получение числа, записанного цифрами заданного числа в обратном порядке

Public Function Obratnoe(a As Double) As String

Dim n As Integer, i As Integer

n = Len(Format(a))

Obratnoe = ""

For i = n To 1 Step -1

Obratnoe = Obratnoe + Mid(Format(a), i, 1)

Next i


If a < 0 Then

Obratnoe = -Obratnoe(Abs(a))

End If

End Function




'Нахождение суммы делителей числа N

Public Function Сумма_делителей(n As Double) As Double

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



'Вычисление суммы первых n чисел Фибоначчи

Public Function Sum(n As Double) As Double

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

Sum = s - 1

End Function
'Определить, является ли заданное число N автоморфным

Public Function Автоморфное(n As Variant) As String

If n ^ 2 Mod 10 ^ Len(n) = n Then

Автоморфное = "Да"

Else

Автоморфное = "Нет"



End If

End Function


'На отрезке [n, m] найти все автоморфные числа

Public Function avtomorf_chis(n As Integer, m As Integer) As Variant

Dim k As String, i As Integer

k = ""


For i = n To m

If Автоморфное(i) = "Да" Then

k = k + " " + Format(i) + ","

End If


Next i

avtomorf_chis = Left(k, Len(k) - 1)

End Function
'Определить, является ли заданное число n числом Армстронга

Public Function fun (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



fun = "Да"

Else


fun = "Нет"

End If


End Function

'На отрезке [n, m] найти все числа Армстронга

Public Function Vse_armstronga(n As Integer, m As Integer) As Variant

Dim i As Integer, k As String

k = ""


For i = n To m

If fun (i) = "Да" Then

k = k + " " + Format(i) + ","

End If


Next i

Vse_armstronga = Left(k, Len(k) - 1)

End Function
'Определить, является ли заданное число N полиндромом

Public Function Полиндром(a As Double) As String

If Format(a) = Obratnoe(a) Then

Полиндром = "Да"

Else

Полиндром = "Нет"



End If

End Function


'На отрезке [n, m] найти все полиндромы

Public Function Vse_polindr(n As Integer, m As Integer) As Variant

Dim k As String, i As Double

k = ""


For i = n To m

If Полиндром(i) = "Да" Then

k = k + " " + Format(i) + ","

End If


Next i

Vse_polindr = Left(k, Len(k) - 1)

End Function
'Определить, является ли заданное число N совершенным

Public Function Совершенное(n As Double) As String

If Сумма_делителей(n) = n Then

Совершенное = "Да"

Else

Совершенное = "Нет"



End If

End Function


'На отрезке [n, m] найти все совершенные числа

Public Function Vse_sowersh(n As Integer, m As Integer) As Variant

Dim k As String, i As Double

k = ""


For i = n To m

If Совершенное(i) = "Да" Then

k = k + " " + Format(i) + ","

End If


Next i

Vse_sowersh = Left(k, Len(k) - 1)

End Function
'На отрезке [n, m] найти все числа близнецы

Public Function Vse_blizneci(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


Vse_blizneci = Left(k, Len(k) - 2)

End Function


1 Разработать ф-цию пользователя, вычисляющую произведение двух больших отрицательных чисел, из трех заданных.

Public Function Задание1(A, b, c As Single) As Variant

If A < 0 And b < 0 And c < 0 Then

If Abs(A) < Abs(c) And Abs(b) < Abs(c) Then Задание1 = A * b

If Abs(b) < Abs(A) And Abs(c) < Abs(A) Then Задание1 = b * c

If Abs(A) < Abs(b) And Abs(c) < Abs(b) Then Задание1 = A * c

Else

If A >= 0 And b < 0 And c < 0 Then



Задание1 = b * c

Else


If b >= 0 And A < 0 And c < 0 Then

Задание1 = A * c

Else

If c >= 0 And A < 0 And b < 0 Then



Задание1 = A * b

Else


Задание1 = "введите хотя бы 2 отрицательных числа!"

End If


End If

End If


End If

End Function


2 Разработать ф-цию пользователя, вычисляющую сумму всех четырехзначных чисел, которые при делении на 9, дают в остатке8.

Public Function Задание2()

For i = 1007 To 9999 Step 9

Задание2 = Задание2 + i

Next i

End Function



3 Разработать ф-цию пользователя, вычисляющую кол-во четных отрицательных элементов массива.

Public Function Задание3(A As Variant)

n = A.Columns.Count

m = A.Rows.Count

s = 0

For r = 1 To m



For c = 1 To n

If A(r, c) < 0 Then

If A(r, c) Mod 2 = 0 Then s = s + 1

End If


Next c

Next r


Задание3 = s

End Function


5 Разработать ф-цию пользователя, вычисляющую число Армстронга, ближайшее к заданному числу М

Public Function Задание5(m As Integer) As Integer

While True

If Armstrong(m + i) Then Задание5 = m + i: Exit Function

If Armstrong(m - i) Then Задание5 = m - i: Exit Function

i = i + 1

Wend

End Function


Public Function Armstrong(p As Integer) As Boolean

Dim s As Integer, m As Integer

n = Len(Format(p))

s = 0


For i = 1 To n

s = s + Mid(p, i, 1) ^ n

Next i

If s = p Then Armstrong = True Else Armstrong = False



End Function

7 Для выделенного диапазона рабочей таблицы переставить элементы с максимальным и минимальным произведением цифр

Public Sub Задание7()

Dim i, x1, x2, j, y1, y2 As Integer

Dim z As Integer

Dim p As Integer

Dim A, b As Variant

Dim m As Integer

Dim n As Integer

A = Selection.Value

m = Selection.Rows.Count

n = Selection.Columns.Count
z = A(1, 1)

Max = Proizved(z)

Min = Proizved(z)

x1 = 1


y1 = 1

x2 = 1


y2 = 1
For i = 1 To m

For j = 1 To n

p = A(i, j)

If Proizved(p) > Max Then Max = Proizved(p): x1 = i: y1 = j

If Proizved(p) < Min Then Min = Proizved(p): x2 = i: y2 = j

Next j


Next i

b = A(x1, y1)

A(x1, y1) = A(x2, y2)

A(x2, y2) = b

Selection.Value = A

End Sub
Public Function Proizved(A As Integer) As Integer

Dim i, m, k As Integer

m = 1


k = Len(Format(A))

If A > 0 Then

For i = 1 To k

m = m * Mid(Format(A), i, 1)

Next i

Else


If A = 0 Then

m = 0


Else

For i = 2 To k

m = m * Mid(Format(A), i, 1)

Next i


End If

End If


Proizved = m

End Function


Public Function Фибоначи(n)

Dim a As Integer

Dim b As Integer

Dim c As Integer

Dim s As Double

a = 1

b = 1


s = 0

If n = 1 Then

s = 1

Else


If n = 2 Then

s = 2


Else

For i = 3 To n

c = a + b

s = s + c

a = b

b = c


Next i

End If


End If

Фибоначи = s

End Function

Public Function minsum(n, m)

Dim s As Double

Dim i As Integer

Dim ss As Double

s = 0


i = 0

While s < m

s = s + i

i = i + 1

Wend

ss = s - (i - 1)



If (m - ss) > (s - m) Then

minsum = ss

Else

minsum = s



End If

End Function

Public Function sum10(n)

'сумма факториалов'

Dim s As Double

Dim i As Integer

Dim p As Double

s = 0

p = 1


For i = 1 To n

p = p * i

s = s + p

Next i


sum10 = s

End Function

Public Function cos11(x, n)

Dim i As Integer

Dim s As Double

Dim p As Double

s = 1

p = 1


i = 1

For i = 1 To n

p = -p * x ^ 2 / (i * (i + 1))

s = s + p

i = i + 1

Next i


cos11 = s

End Function


Public Function pribl(x, E)

'вычисление приближ.значения'

Dim i As Integer

Dim p As Double

Dim s As Double

p = 1

s = 1


i = 1

While Abs(p) > E

p = p * x / i

s = s + p

i = i + 1

Wend


pribl = 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


Функция вычисления значения многочлена Pn(x) в точке Х0

Public Function ЗНАЧЕНИЕ_ПОЛИНОМА_В_ТОЧКЕ(A As Variant, X)

Dim M As Integer

Dim I As Integer

M = A.Columns.Count

P = A(1)


For I = 2 To M

P = P * X + A(I)

Next I

ЗНАЧЕНИЕ_ПОЛИНОМА_В_ТОЧКЕ = P



End Function
Функция подсчета количества символа пробел в строке

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


На отрезке [n,m] найти все такие простые числа, в числовой записи которых присутствует цифра IK-1I. Для ввода исходных данных и вывода результатов, должна быть разработана пользовательская форма.(3 балла)
Private Sub CommandButton1_Click()

n = Val(t1)

m = Val(t2)

k = Val(t3)

For i = n To m

If funct5(i) = True And m >= (i + 2 * k) And funct5(i + 2 * k) = True Then

ListBox1.AddItem (i & " и " & (i + 2 * k))

End If


Next i

End Sub
Private Sub CommandButton2_Click()- Сброс

t1 = Empty

t2 = Empty

t3 = Empty

ListBox1.Clear

End Sub
Private Sub CommandButton3_Click()- Выполнить

Простые_числа.Hide

End Sub
Разработать пользовательскую форму, для определения типа треугольника.(1 балл)
Private Sub CommandButton1_Click()

a = Val(t1)

b = Val(t2)

c = Val(t3)

If a + b > c And a + c > b And c + b > a Then

If a = b And b = c Then

t4 = "равносторонний"

ElseIf a = b Or a = c Or b = c Then

t4 = "равнобедренный"

ElseIf a ^ 2 + b ^ 2 = c ^ 2 Or a ^ 2 + c ^ 2 = b ^ 2 Or b ^ 2 + c ^ 2 = a ^ 2 Then

t4 = "прямоугольный"

Else


t4 = "произвольный"

End If


Else

t4 = "не существует"

End If

End Sub
Private Sub CommandButton2_Click()



t1 = Empty

t2 = Empty

t3 = Empty

t4 = Empty

Треугольник.Hide

End Sub


Разработать пользовательскую форму, для решения уравнения a*x+b=0.(1 балл)
1)Private Sub CommandButton1_Click()

Dim c As Double

a = Val(t1)

b = Val(t2)

c = -b

If a = 0 And c = 0 Then



x = "любое"

ElseIf a = 0 Then

x = "нет решений"

Else


x.Value = c / a

End If


End Sub

2)Private Sub CommandButton2_Click()

t1 = Empty

t2 = Empty

x = Empty

Уравнение.Hide

End Sub
Public Sub Задание7()

Dim Maxi, Maxj, Mini, Minj, c As Integer, Max, Min, t As Double

a = Selection.Value

m = Selection.Rows.Count

n = Selection.Columns.Count

If n = 1 And m = 1 Then

Exit Sub

End If


For i = 1 To m

For j = 1 To n

If a(i, j) = 0 Then

c = c + 1

End If

Next j


Next i

If c = m * n Then

Exit Sub

End If


Max = Сумма_цифр(a(1, 1))

Min = Сумма_цифр(a(1, 1))

Maxi = 1

Maxj = 1


Mini = 1

Minj = 1


For i = 1 To m

For j = 1 To n

If Сумма_цифр(a(i, j)) > Max Then

Max = Сумма_цифр(a(i, j))

Maxi = i

Maxj = j


End If

If Сумма_цифр(a(i, j)) < Min Then

Min = Сумма_цифр(a(i, j))

Mini = i


Minj = j

End If


Next j

Next i


t = a(Maxi, Maxj)

a(Maxi, Maxj) = a(Mini, Minj)

a(Mini, Minj) = t

Selection.Value = a



End Sub



База данных защищена авторским правом ©uverenniy.ru 2016
обратиться к администрации

    Главная страница