если нет равных элементов, то вывести массив по убыванию последней цифры.
вообще бред какой-то творю

Const
     Nmax=10000;
Var
   A:Array[1..Nmax] of Integer;
   flag:Byte;
   i,j,n:integer;
procedure Sort(Var x,y:integer);
Var
   tmp:integer;
Begin
     tmp:=x;
     x:=y;
     y:=tmp;
end;
procedure Poisk(x:integer; flag:Byte);
Var
k,y:Byte;
Begin
     flag:=1;
     y:=x mod 10;
     for I := 1 to n-1 do begin
      for k := i+1 to n do begin
        If a[i]=a[k] Then begin
              flag:=0;
              Break;
           end;
      end;
     end;
end;
Begin
     Writeln('Vvedite dliny posledovatelnosti(n<=10000)');
     Read(n);
     Writeln('Vvedite posledovatelnost');
     flag:=0;
     For i:=1 to n Do
     Begin
         Read(A[i]);
         If flag=0 Then
            Poisk(A[i],flag);
     end;
     If flag=1 Then Begin
        For i:=1 to n-1 Do Begin
            For j:=i+1 to n Do
                If (A[i]mod 10)<=(A[j]mod 10) Then
                   Sort(A[i],A[j]);
        end;
     end;
For i:=1 to n Do WriteLn(A[i]);
Readln;
Readln;
end.

Побочные эффекты от некорректного использования глобальных переменных... У тебя I в цикле ввода и I в процедуре Poisk - одна переменная. И ведет она себя поэтому непредсказуемо... Объяви локальную переменную I в процедуре, и почти все встанет на свои места (почти - потому, что для того, чтобы определить, не вводился ли уже раньше тот элемент, который был введен только что, достаточно ОДНОГО цикла...)

спасибо.
исправил переменную. но есть еще ошибки, я так подозреваю.
попробую в один цикл.

удалил Y. больше ничего не могу найти T_T

Покажи, что у тебя есть на данный момент...

почти то же самое.

Const
     Nmax=10000;
Var
   A:Array[1..Nmax] of Integer;
   flag:Byte;
   i,j,n:integer;
procedure Sort(Var x,y:integer);
Var
   tmp:integer;
Begin
     tmp:=x;
     x:=y;
     y:=tmp;
end;
procedure Poisk(x:integer; flag:Byte);
Var
i,k:Byte;
Begin
     flag:=1;
     for I := 1 to n-1 do begin
      for k := i+1 to n do begin
        If a[i]=a[k] Then begin
              flag:=0;
              Break;
           end;
      end;
     end;
end;
Begin
     Writeln('Vvedite dliny posledovatelnosti(n<=10000)');
     Read(n);
     Writeln('Vvedite posledovatelnost');
     flag:=0;
     For i:=1 to n Do
     Begin
         Read(A[i]);
         If flag=0 Then
            Poisk(A[i],flag);
     end;
     If flag=1 Then Begin
        For i:=1 to n-1 Do Begin
            For j:=i+1 to n Do
                If (A[i]mod 10)<=(A[j]mod 10) Then
                   Sort(A[i],A[j]);
        end;
     end;
For i:=1 to n Do WriteLn(A[i]);
Readln;
Readln;
end.

еще предложения есть?

Смотри:

Const
  Nmax=10000;
Var
  A:Array[1..Nmax] of Integer;

procedure Sort(Var x,y:integer);
Var
  tmp:integer;
Begin
  tmp:=x;
  x:=y;
  y:=tmp;
end;

{ 
  flag должен быть описан как VAR параметр, кроме этого 
  передаем номер вводимого в данный момент элемента,
  чтоб сравнить его со всеми предыдущими
}
procedure Poisk(x, size: integer; var flag: Byte);
var
  i: integer;
Begin
  flag := 1; { 1 если элемент уже встречался ранее }
  for i := 1 to size - 1 do
    if a[i] = X then exit;
  flag := 0; { 0 если этого элемента еще не было }
end;

{ Переменные описаны здесь, потому что выше они тебе не нужны... }
var
  flag:Byte;
  i, j, n: integer;

Begin
  Writeln('Vvedite dliny posledovatelnosti(n<=10000)');
  Readln(n);
  Writeln('Vvedite posledovatelnost');

  flag:=0;
  For i:=1 to n Do
  Begin
    Readln(A[i]);
    If flag=0 Then
      Poisk(A[i], i, flag);
  end;

  If flag=1 Then Begin
    For i:=1 to n-1 Do Begin
      For j:=i+1 to n Do
        If (A[i]mod 10)<=(A[j]mod 10) Then
          Sort(A[i],A[j]);
    end;
  end;

  For i:=1 to n Do WriteLn(A[i]);
  Readln;
end.

Вот так вот...

все так просто и понятно
огромное спасибо)

Добавлено через 4 мин.
все равно не работает х_х

Не принято! Подпись мою внимательно читал? Программа проверена, вот лог работы:

Что не устроило? Как ДОЛЖНО БЫТЬ на этих исходных данных? Сказать "все равно не работает" - слишком просто, тебе не кажется?

Добавлено через 2 мин.
Или поменять

  If flag=1 Then Begin { <--- здесь }
    For i:=1 to n-1 Do Begin
      For j:=i+1 to n Do
        If (A[i]mod 10)<=(A[j]mod 10) Then
          Sort(A[i],A[j]);
    end;
  end;

единицу на 0 - это ОЧЕНЬ сложно? Ты же знаешь свое задание, я написал, что значит ноль, а что значит единица для Flag-а... В чем проблема вообще?

оп, извиняюсь)
ну не заметил, бывает)