Даны натуральные числа x,y,z, определяющие возраст трех друзей. Из данных чисел напечатать те, которые обозначают «школьный возраст», то есть от 7 до 16 лет.

Даны натуральные числа x,y,z, определяющие возраст трех друзей. Из данных чисел напечатать те, которые обозначают «школьный возраст», то есть от 7 до 16 лет.

 

Sub primer6()

Dim x As Single

Dim y As Single

Dim z As Single

x = Val(InputBox("Введите первое число", "Ввод числа"))

y = Val(InputBox("Введите второе число", "Ввод числа"))

z = Val(InputBox("Введите второе число", "Ввод числа"))

If x >= 7 And x <= 16 Then

MsgBox x & ("- школьный возраст")

Else

MsgBox "данное число не определяет школьный возраст"

End If

If y >= 7 And y <= 16 Then

MsgBox y & ("- школьный возраст")

Else

MsgBox "данное число не определяет школьный возраст"

End If

If z >= 7 And z <= 16 Then

MsgBox z & ("- школьный возраст")

Else

MsgBox "данное число не определяет школьный возраст"

End If

End Sub

Племя каннибалов решило съесть своих соседей, но дикари не знали, какое из трех ближайших племен выбрать: если в племени мало народу – то на всех каннибалов не хватит, если много – самих каннибалов побьют. Оптимальное количество известно: от 50 до 65 человек. Соответственно, в племенах было Х, Y, Z жителей. Какое из этих трех племен людоеды могут съесть?

Sub test()

Dim x As Integer, y As Integer, z As Integer, a As Integer

x = Val(InputBox("первое племя"))

y = Val(InputBox("второе племя"))

z = Val(InputBox("третье племя"))

If x >= 50 And x <= 65 Then

MsgBox "первое племя могут съесть"

Else

MsgBox "не получится c первым"

End If

If y >= 50 And y <= 65 Then

MsgBox "второе племя могут съесть"

Else

MsgBox "не получится со вторым"

End If

If z >= 50 And z <= 65 Then

MsgBox "третье племя могут съесть"

Else

MsgBox "не получится с третьим"

End If

End Sub

3. За контрольную работу в классе учениками было получено P пятерок, СН четверок, TR троек и DV двоек. Определить:

A. Сколько человек учится в классе

B. Каков средний балл

C. Сколько учеников получили оценку, превышающую средний балл?

 

Program nom5;

uses crt;

Var

P,CH,TR,DV,k,t,n:integer;

SR:real;

Begin

clrscr;

Writeln('vvedite kol-vo "5"');

Readln(P);

Writeln('vvedite kol-vo "4"');

Readln(CH);

Writeln('vvedite kol-vo "3"');

Readln(TR);

Writeln('vvedite kol-vo "2"');

Readln(DV);

k:=P+CH+TR+DV;

Writeln('v klasse: ',k, ' chelovek');

n:=k;

SR:=(P*n+CH*n+TR*n+DV*n)/k;

t:=0;

if (SR>4) and (SR<=5) then t:=P;

if (SR>3) and (SR<=4) then t:=P+CH;

if (SR>2) and (SR<=3) then t:=TR+CH+P;

if (SR<2) then t:=DV+TR+CH+P;

 

Writeln('srednii bal = ',SR:5:3);

Writeln('previchaet srednii bal: ',t);

Readln;

end.

4. Является ли заданное четырехзначное число N палиндромом (то есть «перевертышем» например таковыми являются числа 8998, 3333)?

 

Sub задание7()

Dim n As Integer

Dim l As Integer

Dim i As String

n = InputBox("введите четырехзначное число", "ввод переменной")

If Mid(n, 1, 1) = Mid(n, 4, 1) And Mid(n, 2, 1) = Mid(n, 3, 1) Then

MsgBox "число " & n & " является полиндромом", vbOKOnly, "ответ"

Else

MsgBox "число " & n & " не является полиндромом", vbOKOnly, "ответ"

End If

End Sub

Из-за непогоды были отменены рейсы самолетов. Нанадолго проглянуло солнце: на N часов и M минут. Сколько самолетов успеет вылететь за это время, если на взлетной полосе может быть только один самолет, а интервал между взлетом двух самолетов - X минут.

 

Sub задание1()

Dim m As Integer

Dim n As Integer

Dim z As String

Dim x As Integer

m = Val(InputBox("Введите количество минут m", "Ввод m"))

x = Val(InputBox("Введите интервал мд самолетами", "Ввод x"))

z = "n="

n = m / x

MsgBox z & n,, "Результат"

End Sub

6. Вычислить сумму ряда чисел:

a. 2+4+6+…+100

б.

а) Sub задание1а()

Dim i As Integer

Dim s As Integer

s = 0

For i = 2 To 100 Step 2

s = s + i

Next i

MsgBox "сумма ряда равна" & s, vbDefaultButton1, "ответ"

End Sub

б) Sub задание1b()

Dim i As Integer

Dim s As Single

Dim n As Single

s = 0

For i = 2 To 100

n = 1 / i

s = s + n

Next i

MsgBox "сумма ряда равна " & s, vbDefaultButton1, "ответ"

End Sub

7. Дано натуральное N. Определить:

A. Количество цифр числа

B. Сумму цифр

C. Младшую и старшую цифры

D. Есть ли в записи числа цифра «5»

 

Program zad13b_2;

uses crt;

var n:string;i,s,d,err:integer;

Begin

clrscr;

write('vvedite chislo '); readln(n);

writeln(length(n),' cifr');

s:=0;

for i:=1 to length(n) do begin

val(n[i],d,err);

s:=s+d;

end;

writeln ('summa=',s);

writeln('pervaya: ',n[1],' poslednyaia: ',n[length(n)]);

i:=1;

repeat

inc(i);

until (n[i]='5') or (i>length(n));

if (i>length(n)) then writeln('ne vstrechaetsta') else writeln('vstrechaetsya');

readln;

end.

8. Клиент открыл счет в банке 1 марта, вложив 1000 рублей. Каждый месяц размер вклада увеличивается на 2 %. Определить:

A. Сколько денег будет на счете через 6 месяцев.

B. В каком месяце размер вклада превысит 1200 руб.

C. За какой месяц величина ежемесячного увеличения вклада превысит 50 руб.

 

Program zad15a;

uses crt;

var i,m:integer;

x1,x:real;

Begin

clrscr;

x:=1000;

m:=0;

For i:=1 to 6 do

Begin

x:=x+x*0.02;

end;

writeln(x:5:8);

x:=1000;

while x<1200 do

begin

m:=m+1;

x:=x+x*0.02;

end;

writeln('v ',m, ' mesaze');

x:=1000;

m:=0;

while x*0.02<=50 do

Begin

m:=m+1;

x:=x+x*0.02;

End;

writeln(m);

readln;

End.

Sub pr1()

Dim A(31) As Integer, s1 As Single, i As Integer, s2 As Single, s As Single, sr As Single, str As String, str2 As String, srm As Single

Randomize

s1 = 0

s1 = 0

s = 0

str = ""

str2 = ""

For i = 1 To 31

'A(i) = Val(InputBox("введите температуру" & i & "марта"))

A(i) = Int(15 * Rnd + 1 - 15 * Rnd)(Rnd-возвращает значение, которое меньше 1, но больше или равно нулю.)

str = str & A(i) & " "

If A(i) < 0 Then

s1 = s1 + 1

End If

If A(i) > 0 Then

s2 = s2 + 1

End If

s = s + A(i)

Next

sr = Int(s / 31)

 

For i = 1 To 31

If A(i) = sr Or A(i) + 1 = sr Or A(i) - 1 = sr Then

str2 = str2 & i & " "

End If

Next

MsgBox str & Chr(13) & "количество дней с отриц. температурой =" & s1 & Chr(13) & "количество дней с положительной температурой =" & s2 & Chr(13) & "Средняя температура месяца =" & sr & Chr(13) & "дни когда темп была близка к ср.мес." & str2

End Sub

В массиве N натуральных чисел. Составить новый массив из чисел, в записи которых есть одинаковые цифры. В новом массиве числа не должны повторяться. Вывести на экран исходный и полученный массивы.

Program gos19;

uses crt;

var

i,n,k,a,b,c: byte;

Tab,Tmp,Res: array [1..100] of integer;

 

function Check(num: integer): boolean;

var

s: string;

j,h,chk: byte;

begin

str(num,s);

chk:=0;

for j:=1 to length(s)-1 do

for h:=j+1 to length(s) do

if (s[j]=s[h]) and (j<>h) then Inc(chk);

if chk>0 then Check:=true else Check:=false;

end;

 

begin

clrscr;

writeln('Enter N');

readln(n);

randomize;

for i:=1 to n do

begin

Tab[i]:=random(16000);

{ k:=random(10);

Tab[i]:=k*10+k;}

write(Tab[i],' ');

end;

k:=0;

for i:=1 to n do

if Check(Tab[i])=true then

begin

Inc(k);

Tmp[k]:=Tab[i];

end;

 

if k>0 then

begin

 

b:=1;

Res[1]:=Tmp[1];

for i:=2 to k do

begin

c:=i;

for a:=1 to b do

if Tmp[i]=Res[a] then Inc(c);

if c=i then

begin

Inc(b);

Res[b]:=Tmp[i];

end;

end;

 

writeln;

writeln;

writeln('Result matrix:');

for i:=1 to b do

begin

write(Res[i],' ');

end;

end

else writeln('There are NO ELEMENTS in matrix!');

readln;

end.

В зрительном зале N рядов по М мест в каждом. Информация о проданных билетах хранится в двух матрицах: в первой матрице в соответствующей ячейке указана цена билета за данное место, а во второй – продан билет на это место или нет(билет продан – «1», не продан – «0»). Подсчитать общую выручку за проданные билеты.

 

Sub primer6()

Dim n As Single

Dim m As Single

Dim A() As Integer

Dim A1() As Integer

Dim i As Integer

Dim j As Integer

Dim s As Single

1: n = Val(InputBox("введите число рядов", "Ввод числа"))

If n < 1 Or Fix(n) <> n Then

MsgBox "некорректно введено число рядов, попробуйте еще",, " "

GoTo 1

End If

 

2: m = Val(InputBox("введите число мест", "Ввод числа"))

If m < 1 Or Fix(m) <> m Then

MsgBox "некорректно введено число мест, попробуйте еще",, " "

GoTo 2

End If

 

ReDim A(n, m), A1(n, m)

 

For i = 1 To n

For j = 1 To m

3: A(i, j) = Val(InputBox("Введите цену билета на " & i & " ряд" & j & " место"))

If A(i, j) < 1 Then

MsgBox "некорректно введенa цена, попробуйте еще раз",, " "

GoTo 3

End If

Next

Next

 

For i = 1 To n

For j = 1 To m

4: A1(i, j) = Val(InputBox("Введите наличие в кассе билета на " & i & " ряд" & j & " место(1 - билет продан,0 - не продан)"))

If A1(i, j) <> 1 And A1(i, j) <> 0 Then

MsgBox "некорректно введено число(1 - билет продан,0 - не продан), попробуйте еще раз",, " "

GoTo 4

End If

Next

Next

s = 0

For i = 1 To n

For j = 1 To m

s = s + A(i, j) * A1(i, j)

Next

Next

MsgBox "Выручка за проданные билеты = " & s & "рубль(ей)",, "ответ"

End Sub

 

12. Даны две прямоугольные числовые матрицы А и В размера М Х N. Построить третью матрицу С по правилу: c[I,j]=a[I,j]*b[I,j].

 

 

program z23;

uses crt;

const

n=3;m=3;

a: array[1..n,1..m] of integer = ((3,1,2),

(2,5,1),

(2,2,2));

b: array[1..n,1..m] of integer = ((5,1,1),

(4,1,2),

(1,1,0));

var

i,j: integer;

c: array[1..n,1..m] of integer;

BEGIN

clrscr;

for i:=1 to n do

for j:=1 to m do c[i,j]:=a[i,j]*b[i,j];

 

for i:=1 to n do

begin

for j:=1 to m do write(c[i,j],' ');

writeln;

end;

readln;

END.

Задан целочисленный файл, содержащий большое количество нулей. Заменить группы элементов, состоящие из нечетного количества нулей, на один нулевой элемент, а из четного – на два. Полученную последовательность поместить в новый файл. Вывести на экран содержимое обоих файлов.

program z41;

uses crt;

const

n=200;

var

a: array [1..200] of integer;

i,ncnt,cnt,nul: integer;

f: file of integer;

procedure make_file(fp: string);

var

f: file of integer;

i: integer;

s: integer;

begin

assign (f,fp);

rewrite(f);

randomize;

for i:=1 to n do

begin

s:=trunc(random(2));

write (f,s);

end;

close(f);

end;

procedure get_file(fp: string);

var f: file of integer;

i: integer;

begin

assign (f,fp);

reset(f);

i:=1;

while (not eof(f)) do

begin

read(f,a[i]);

inc (i);

end;

ncnt:=i-1;

close(f);

end;

BEGIN

clrscr;

make_file('z42src.bin');

get_file('z42src.bin');

for i:=1 to n do write(a[i],' '); writeln('-----------');

assign(f,'z42rslt.bin');

rewrite (f);

nul:=0;

for i:=1 to n do

begin

write(f,a[i]);

if (a[i]=0) then

begin

cnt:=0;

while ((a[i]=0) AND (i<=n)) do

begin

inc(i); cnt:=cnt+1;

end;

if (cnt>0) then dec(i);

if ((cnt mod 2)=0) then write(f,nul);

end;

end;

close(f);

get_file('z42rslt.bin');

for i:=1 to ncnt do write(a[i],' ');

readln;

END.

Даны натуральные числа x,y,z, определяющие возраст трех друзей. Из данных чисел напечатать те, которые обозначают «школьный возраст», то есть от 7 до 16 лет.

 

Sub primer6()

Dim x As Single

Dim y As Single

Dim z As Single

x = Val(InputBox("Введите первое число", "Ввод числа"))

y = Val(InputBox("Введите второе число", "Ввод числа"))

z = Val(InputBox("Введите второе число", "Ввод числа"))

If x >= 7 And x <= 16 Then

MsgBox x & ("- школьный возраст")

Else

MsgBox "данное число не определяет школьный возраст"

End If

If y >= 7 And y <= 16 Then

MsgBox y & ("- школьный возраст")

Else

MsgBox "данное число не определяет школьный возраст"

End If

If z >= 7 And z <= 16 Then

MsgBox z & ("- школьный возраст")

Else

MsgBox "данное число не определяет школьный возраст"

End If

End Sub

Племя каннибалов решило съесть своих соседей, но дикари не знали, какое из трех ближайших племен выбрать: если в племени мало народу – то на всех каннибалов не хватит, если много – самих каннибалов побьют. Оптимальное количество известно: от 50 до 65 человек. Соответственно, в племенах было Х, Y, Z жителей. Какое из этих трех племен людоеды могут съесть?

Sub test()

Dim x As Integer, y As Integer, z As Integer, a As Integer

x = Val(InputBox("первое племя"))

y = Val(InputBox("второе племя"))

z = Val(InputBox("третье племя"))

If x >= 50 And x <= 65 Then

MsgBox "первое племя могут съесть"

Else

MsgBox "не получится c первым"

End If

If y >= 50 And y <= 65 Then

MsgBox "второе племя могут съесть"

Else

MsgBox "не получится со вторым"

End If

If z >= 50 And z <= 65 Then

MsgBox "третье племя могут съесть"

Else

MsgBox "не получится с третьим"

End If

End Sub

3. За контрольную работу в классе учениками было получено P пятерок, СН четверок, TR троек и DV двоек. Определить: