Дана матрица размера m×n. найти минимальный среди максимальных элементов ее столбцов. в excel vba

Dim i As Integer, j As Integer, n As Integer, m As Integer
Dim z() As Integer, max() As Integer, min As Integer
n = InputBox("Введите число строк")
m = InputBox("Введите число столбцов")
ReDim z(n, m)
ReDim max(m)
For i = 1 To n
For j = 1 To m
z(i, j) = Rnd * 100 - 50
Cells(i + 2, j + 2) = z(i, j)
Next
Next
For j = 1 To m
For i = 1 To n
If max(j) < z(i, j) Then max(j) = z(i, j)
Next
Next
min = 100
For j = 1 To m
Cells(n + 4, j + 2) = max(j)
If max(j) < min Then min = max(j)
Next
Cells(n + 6, 3) = min

Вариант в Excel 2003.
Программа в редакторе VBA.
см. прикрепленный файл.

Program fofgogjoj;
 var   
arr: array[1..1000] of byte;   
max_num, min_num: byte;   
i: byte;   
n,p:integer; 
begin   
randomize; 
Wriiteln('Введите число n');
Readln(n);   
for i := 1 to n do begin       
arr[i] := random(100);       
 Write (arr[i]:3);   
end;       
 max_num := arr[1];    
for i := 2 to n do       
 if arr[i] > max_num then
begin                     
max_num := arr[i];       
end;    
Writeln;   
Writeln ('Max = ',max_num);          
min_num := arr[1];    
for i := 2 to n do       
if arr[i] < min_num then
begin                      
min_num := arr[i];       
end;       
Writeln;   
Writeln ('Min = ',min_num);       
P:=max_num*min_num;   
Writeln('Произведение равно:',p); 
end.

1)

Uses crt, graphABC;
var a,c:real;
N,i,r,g,b:integer;
begin
circle(100,100,80);
read(N);
a:=0;
c:=360;
r:=5;g:=5;b:=5;
for i:=1 to N do begin
pie(100,100,80,a,c);
FloodFill(145,97,RGB(r,g,b));
c:=c-360/N;
r:=r+30;
g:=g+10;
b:=b+45;
end;
end.

 

2)

Uses crt, graphABC;
var N,i,x1,y1,x2,y2:integer;
begin
read(N);
x1:=350;
y1:=10;
x2:=360;
y2:=15;
for i:=1 to N do begin
randomize;
SetBrushColor(RGB(random(256),random(256),random(256)));
rectangle(x1,y1,x2,y2);
FillRect(x1,y1,x2,y2);
x1:=x1-5*i;
y1:=y2-1;
x2:=x2+5*i;
y2:=y2+i*5;
end;
end.

 

3)

var a,min,max,f:integer;
begin
f:=0;
Repeat
read(a);
if a<>0 then begin
if f=0 then begin
min:=a;
max:=a;
end else begin
if a<min then min:=a;
if a>max then max:=a;
end;
f:=f+1;
end;
UNTIL a=0;
Writeln(max*min);
end.

 

4)

var a,max1,max2,f:integer;
begin
f:=0;
Repeat
read(a);
if a<>0 then begin
if f=0 then begin
max1:=a;
end else
if f=1 then begin
if a<max1 then max2:=a else begin
max2:=max1;
max1:=a;
end;
end else begin
if a>max1 then max1:=a;
if (a>max2) and (a<=max1) then max2:=a;
end;
f:=f+1;
end;
UNTIL a=0;
Writeln(max1+max2);
end.

 

5)

var a,min1,min2,min3,f:integer;
begin
f:=0;
Repeat
read(a);
if a<>0 then begin
if f=0 then begin
min1:=a;
end else
if f=1 then begin
if a>min1 then min2:=a else begin
min2:=min1;
min1:=a;
end;
end else
if f=2 then begin
if (a>min1) and (a>min2) then min3:=a else if (a>=min1) and (a<=min2) then begin
min3:=min2;
min2:=a;
end else begin
min3:=min2;
min2:=min1;
min1:=a;
end;
end else begin
if a<min1 then begin
min3:=min2;
min2:=min1;
min1:=a; end else
if (a<min2) and (a>=min1) then begin
min3:=min2;
min2:=a;
end else
if (a>=min2) and(a<min3) then min3:=a;
end;
f:=f+1;
end;
UNTIL a=0;
Writeln((min1+min2+min3)/3:3:3);
end.