Дан одномерный массив А,размерностью1*n (2<=n<=20) элементы массива принимают от 0 до 20000 устанавливаются польхователем. Все положиттельные числа массива А записываются последовательно в массив В, а отрицательные в массив С. определить первое и последнее вхождение положительных и отрицательных чисел в массив А

Что уже готово ? Что конкретно не получается ?

я не много не пойму что делать ( ну почти понил) и как это ваше можно зделать !?

Внимание - вопрос: ОТКУДА среди чисел 0 .. 20000 взялись отрицательные?

nb := 0;
nc := 0;

for i := 1 to n do begin
   readln(a[i]);
   if a[i] > 0 then begin
      inc(nb);
      b[nb] := a[i];
   else
    if a[i] < 0 then begin
       inc(nc);
       c[nc] := a[i];
   end;
end;

Volvo Угу, а я и внимания не обратил ...

это первая часть задания.

ух...... ты и правда. интересно....... мож от -20000 или имелось ввиду честные не четные числа!?

честно говоря проверил вродебы так и написано скорей всего имелось ввиду от -20000 до 20000

klem4, твоя же программа, чуть-чуть подправленная будет выполнять сразу обе части задания:

neg_first := 0; neg_last := 0;
pos_first := 0; pos_last := 0;

nb := 0;
nc := 0;

for i := 1 to n do begin
   readln(a[i]);
   if a[i] > 0 then begin
      inc(nb);
      b[nb] := a[i];
      if pos_first = 0 then begin pos_first := i; pos_last := i end
      else pos_last := i;
   else
    if a[i] < 0 then begin
       inc(nc);
       c[nc] := a[i];
      if neg_first = 0 then begin neg_first := i; neg_last := i end
      else neg_last := i;
   end;
end;

Вот и все, одним проходом ...

(Это, естественно, если диапазон от -20000 до +20000. Для четных/нечетных попробуй исправить сам...)

спасибо что помогли!

вторая часть!

var
pf:byte; полож. 1 вхождение 
pl:byte; --\\-- последнее вхожд.
mf:byte; отрицательное 1
ml:byte; отрицательное послед.

begin
 for pf:=1 to n do
if A[pf]>0 then break;
 for pl:h downto 1 do
if A[pl]<0 then break;
for mf:=1 to n do
if A[mf]>0 then break;
for ml:=n downto 1 do
if A[ml]< then break;

Во первых пользуйся тегами, а во вторых внимательно прочитай предыдущий пост ...

а еще обнулить надо!

а теперь помогите мне собрать всё в одно единое! что бы работало! но надо используя не вот то что волво предлодил первая часть!

что не так?

 program stas3;
uses crt;
var
pf,pl,mf,ml:byte;
n:byte;
a:array [1..n] of integer;

i,nb,nc:integer;

begin
writeln ('vvidite n') ;
readln (n);
nb:=0;
nc:=0;
for i:= 1 to n do begin
readln (a[i]);
if a[i]>0 then begin
inc(nb);
b[nb]:=a[i];
else
 if a[i]<0 then begin
 inc(nc);
 c[nc]:=a[i];
 end;
 end;
  begin
  pf:=0;
  pl:=0;
  mf:=0;
  ml:=0;
  for pf:=1 to n do
  if a[pf]>0 then break;
  for pl:=n downto 1 do
  if a[pl]<0 then break;
  for mf:=1 to n do
  if a[mf]>0 then break;
  for ml:=n downto 1 do
  if a[ml]<0 then break;

end.

помогите мне зделать эту долбаную задачу , до завтра! без неё я на 3 могу не надеятся а с ней за 3 буду бится!

                                 program stas3;
uses crt;
var
pf,pl,mf,ml:byte;
n:byte;
a,b,c:array [1..100] of integer;

i,nb,nc:integer;

begin
writeln ('vvidite n') ;
readln (n);
nb:=0;
nc:=0;
for i:= 1 to n do begin
readln (a[i]);
if a[i]>0 then begin
inc(nb);
b[nb]:=a[i]
end
else
 if a[i]<0 then begin
 inc(nc);
 c[nc]:=a[i];
 end;
 end;

  pf:=0;
  pl:=0;
  mf:=0;
  ml:=0;
  for pf:=1 to n do
  if a[pf]>0 then break;
  for pl:=n downto 1 do
  if a[pl]<0 then break;
  for mf:=1 to n do
  if a[mf]>0 then break;
  for ml:=n downto 1 do
  if a[ml]<0 then break;

end.

Убрал по крайней мере все синтаксические ошибки ...