Дана матрица.

tmp := 0; // в ней будем хранить номер столбца 
for j := 1 to M do
  for i := 1 to N do
    if a[i, j] < 0 then
      break
    else
      if i = N then
        tmp := j;

uses crt;
const n=5;
      m=10;
var a:array [1..n,1..m] of integer;
    i,j,k,p,q:byte;
begin
clrscr;
randomize;
writeln('Исходная матрица:');
for i:=1 to n do
 begin
  for j:=1 to m do
   begin
    a[i,j]:=random(20)-4;
    write(a[i,j]:4);
   end;
  writeln;
 end;
p:=0;{пока нужного столбца нет}
for j:=n downto 1 do{идем от последнего столбца}
 begin
  k:=0;
  for i:=1 to n do{в столбце}
  if a[i,j]>0 then k:=k+1;{считаем положительные}
  if k=n then p:=j;{если все, запоминаем очередной столбец}
 end;
if p=0 then write('Столбца, содержащего только положительные элементы нет!')
else
 begin
  writeln('Номер первого столбца, содержащего только положительные элементы =',p);
  if p=m then q:=m-1{если это последний столбец, просто отрезаем}
  else
   begin
    q:=m;{запомним количество столбцов, оно константа и менять нельзя}
    for i:=1 to n do{элементам всех строк}
    for j:=p to q-1 do{от номера найденного столбца до предпоследнего}
    a[i,j]:=a[i,j+1];{меняем значения на следующее, столбец исчезает}
    q:=q-1;{уменьшаем количество столбцов}
    writeln('Результат удаления столбца:');
    for i:=1 to n do
     begin
      for j:=1 to q do
      write(a[i,j]:4);
      writeln;
     end;
   end;
 end;
readln
end.