Помогите срочно!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! завтра нужно(((((( только расспишите полностью листинг

+ 0 -

All12345

16 дек. 2016 г., 6:59:27 (7 лет назад)

Задача поставлена неконкретно. Где находятся данные? В каком виде они записаны?
Предположим, что они находятся в символьном массиве в виде "Иванов Петр Алексеевич, 2 января 2000". Тогда поставленную задачу решает следующая программа на ПаскалеABC.NET

var
  a:array[1..1000]of string;
  b:array[1..1000]of boolean;
  im,d,im1,d1,s:string;
  n,i,j:integer;
  f:boolean;
begin
//массив набиваем вручную. 
//В реальной задаче, удобнее будет считать из файла, 
//наверняка, у секретаря в компьютере такие списки есть. 
//Для иллюстрации заполним всего лишь 10 строк.
a[1]:='Иванов Петр Алексеевич, 2 января 2000';
a[2]:='Сергеев Петр Алексеевич, 13 января 2001';
a[3]:='Иванов Иван Борисович, 2 января 2000';
a[4]:='Петров Владимир Сергеевич, 21 марта 2000';
a[5]:='Фомин Петр Петрович, 2 января 2000';
a[6]:='Сидоров Петр Петрович, 2 января 2000';
a[7]:='Федоров Иван Борисович, 21 марта 2000';
a[8]:='Сидоров Владимир Петрович, 21 марта 2000';
a[9]:='Федосов Иван Иванович, 2 января 2000';
a[10]:='Сергеев Петр Иванович, 2 января 2000';
//.... и т.д.
for i:=1 to 999 do if (a[i]<>'') and (b[i]=false) then
  begin
  f:=false;
  s:=a[i];
  n:=pos(' ',s);
  delete(s,1,n);
  n:=pos(' ',s);
  im:=copy(s,1,n);
  d:=a[i];
  n:=pos(',',d);
  delete(d,1,n);
  for j:=i+1 to 1000 do
    begin
    s:=a[j];
    n:=pos(' ',s);
    delete(s,1,n);
    n:=pos(' ',s);
    im1:=copy(s,1,n);
    d1:=a[j];
    n:=pos(',',d1);
    delete(d1,1,n);
    if (im=im1) and (d=d1) then
       begin
       if f=false then
         begin
         writeln;
         writeln(a[i]);
         f:=true;
         b[i]:=true;
         end;
       writeln(a[j]);
       b[j]:=true;
       end;
    end;
  end;
end.