Поменять местами в каждом столбце матрицы минимальный и максимальный элементы.

const m=6;n=5;
var
  a:array[1..m,1..n] of integer;
  i,j,k,Maxi,Mini:integer;
procedure print(s:string);{печать матрицы}
var
  i,j:integer;
begin  
  writeln(s);
  for i:=1 to m do begin for j:=1 to n do write(a[i,j]:5); writeln; end;
end;  
begin
  randomize;
  for i:=1 to m do for j:=1 to n do  a[i,j]:=random(100);{заполняем матрицу 
  случайными числами}
  print('исходная матрица:');
  {ищем максимальный и минимальный элемент в каждом столбце и меняем местами}
  for j:=1 to n do begin
    Mini:=1;Maxi:=1;{координаты строк с максимальным и минимальным элементом}
    for i:=1 to m do begin
      if a[Mini,j]>a[i,j] then Mini:=i;
      if a[Maxi,j]<a[i,j] then Maxi:=i;
    end;
    k:=a[Mini,j];a[Mini,j]:=a[Maxi,j];a[Maxi,j]:=k;{меняем местами}
  end;  
  print('полученная матрица:');
end.