var i,j,n:word;
    a:array[1..50000] of word;
    f1,f2:text;
procedure qsort(l,r:word);
var i,j,x,t:word;
begin
    i:=l;j:=r;x:=a[(l+r) div 2];
    repeat
        while a[i] < x do inc(i);
        while a[j] > x do dec(j);
        if i<=j then
            begin
                t:=a[i];a[i]:=a[j];a[j]:=t;
                inc(i);dec(j);
            end;
    until i>j;
    if l < j then qsort(l,j);
    if i < r then qsort(i,r);
end;
begin
    assign(f1,'TS.INP');reset(f1);
    assign(f2,'TS.OUT');rewrite(f2);
    readln(f1,n);
    for i:=1 to n do read(f1,a[i]);
    qsort(1,n);
    i:=1;
    while i<=n do
        begin
            j:=i;
            while a[j]=a[j+1] do inc(j);
            if j<>i then
                write(f2,a[i],' ',j-i+1,#13#10);
            i:=j+1;
        end;
    close(f1);close(f2);
end.

Nếu có sai thì nói mình nhé.

===========================

program Hello;
var s:array[1..32000] of integer;
    n,i,a:integer;

    f:text;
begin
    assign(f,'TS.INP');reset(f);   
    readln(f,n);
    for i:= 1 to n do
        begin
            read(f,a);
            inc(s[a]);    
        end;

    close(f);

    assign(f,'TS.OUT');rewrite(f);
    for i:= 1 to 32000 do
        if s[i] > 1 then
            writeln(f, i, ' ', s[i]);

    close(f);
    readln;
    readln;
end.