Имеется 2 файла справочника и один файлик основной. Необходимо сформировать ведомости. Первая ведомость формируется как надо, тоесть как мне надо ). А вот вторая в последнем столбике Количество Струдников не прописывает их количество. Код написан, вроде должно работать, а не тут-то было. Вот в этом файле Нажмите для просмотра прикрепленного файла - процедуры по формированию ведомостей. Нажмите для просмотра прикрепленного файла - первый справочник(текстовый). Нажмите для просмотра прикрепленного файла - основной фаил и второй справочник(оба они типизированные).



Но может вы и без этого увидите как исправить процедуру по созданию второй ведомости.
Заранее благодарен.

Заархивировать все вместе?

всё-всё, выложил все необходимые файлы.
Теперь можешь смотреть

Я понял кажется в чём ошибка, но как устранить...что-то не соображу...

procedure vedomost2_sozdanie;
VAR
  i,w,k,j,t,p,n:integer;
  s1,s2,s3,s4,s,q:string;
  z:tmas;
  x:thmas;
  l:tmasiv;
Begin
  w:=0;
  q:='0';
  i:=0;
  assign(spravochnik1,'spravka1.txt');
  assign(vedomost2,'vedomost2');
  reset(spravochnik1);
  while not(eof(spravochnik1)) do
    begin
      inc(w);
      readln(spravochnik1,s);
    end;
  rewrite(vedomost2);
  reset(spravochnik1);
  with Zap_ved2 do
    While not(eof(spravochnik1)) do
      begin
        readln(spravochnik1,s1);
        readln(spravochnik1,s2);
        readln(spravochnik1,s3);
        readln(spravochnik1,s4);
        Cod_OTDELA:=s1;
        FIO_zava:=s3;
        telefnchik:=s4;
        kol_vo_sotr:=q;
        write(vedomost2,Zap_ved2);
      end;
  close(spravochnik1);
  close(vedomost2);
  sortirovkaVED2;
  sortirovkaosnovpo3_1;

  t:=filesize(osnov);
  getmem(z,t*sizeof(Zap));
  getmem(x,t*sizeof(HZ));
  k:=0;
  while not(eof(osnov)) do
    begin
      read(osnov,Zap);
      inc(k);
      z^[k]:=zap;
    end;
  close(osnov);
  k:=0;
  reset(osnov);
  while not(eof(osnov)) do
    begin
      read(osnov,Zap);
      inc(k);
      x^[k]:=helpzap;       { <-- вот тут я создаю массив записей, но так как первоначально }
    end;                           {файла на него нету, то он собой представляет 1 запись всего, как я понимаю...}
  close(osnov);                 {а мне надо чтобы их было столько же сколько в файле osnov}
  p:=1;
  For i:=1 to t do
    begin
      IF  z^[i].CodeOTD <> z^[i+1].CodeOTD  then     {или может тут ошибка в построение цикла...хотя я вручную проверял...вроде правильно...}
        begin
          x^[i].CODEOTDELA:=z^[i].CodeOTD;
          str(p,x^[i].TAB);
          p:=1;
        end
      Else
        begin
          IF z^[i+1].Tabnomr<>z^[i].Tabnomr then
            inc(p);
        end;
    end;
  freemem(z,t*sizeof(Zap));

  reset(vedomost2);
  j:=filesize(vedomost2);
  getmem(l,j*sizeof(Zap_ved2));
  k:=0;
  while not(eof(vedomost2)) do
    begin
      read(vedomost2,Zap_ved2);
      inc(k);
      l^[k]:=Zap_ved2;
    end;
  close(vedomost2);
  For i:=1 to j do
    FOR n:=1 to t do
      IF l^[i].Cod_OTDELA=x^[j].CODEOTDELA then
        l^[i].kol_vo_sotr:=x^[j].TAB;
  rewrite(vedomost2);
  For i:=1 to j do
    write(vedomost2,l^[i]);
  close(vedomost2);
  freemem(l,j*sizeof(Zap_ved2));
  freemem(x,t*sizeof(HZ));
  sortirovka;
End;

А чего ты гадаешь? Возьми отладчиком и посмотри, сколько элементов пишутся в массив X (чему равно K после его заполнения)... Все ТАМ нормально...

Плохо вот здесь:

  For i:=1 to t do
    begin
      IF  z^[i].CodeOTD <> z^[i+1].CodeOTD  then { <--- При i = T ты вылетаешь за пределы отведенной памяти }

и чуть ниже то же самое...

так вроде когда я вылетаю - то он сравнивает с NIL, а нилу он не равен и действия выполняются...
Ты записускал её с фалами со всеми?
видел что во второй ведомости? только в последнюю строчку добавляется кол-во сотрудников почему-то...

Да не могу я ее запускать... Нет у меня кириллицы, в 16-битных приложениях, сколько раз повторять... Толку то, что я запущу... Я ж результат проверить не могу!

Когда ты обращаешься ЗА пределы памяти, это уже ошибка... В любом нормальном компиляторе это карается Access Violation... А потом, кто тебе сказал, что там nil? Локальная переменная, да еще и динамическая... Мусор там скорее всего, а не nil...

окей, попробую, а так вот скрины:
Нажмите для просмотра прикрепленного файла - соновной фаил. Нажмите для просмотра прикрепленного файла - справочник 1

Нажмите для просмотра прикрепленного файла - справочник 2 . Нажмите для просмотра прикрепленного файла -ведомость 2.

вообщем условие изменилось. В массив x нужна писать в поле x^[i].CODEOTDELA z^[i].CodeOTD, а в поле x^[i].TAB количество идущх подряд записей z^[i], начинающихся на одинаковый код отдела

причём реализовано должно быть так:
если вы массиве Z у нас:
01 *....
01 *....
02 *....
03 *...
03 *...
03 *...
То в массив X записаться должно так:
01 * 2
02 * 1
03 * 3

Что-то я не понимаю как организовать цикл, при этом не выходя за границы памяти выделенной под массив Z...

const
  z_size = 6;
type
  x_arr = array[1 .. z_size] of record
    code: string;
    count: integer;
  end;
  z_arr = array[1 .. z_size] of string;

var
  x: x_arr;
  i, k, p: integer;
const
  z: z_arr = ('01', '01', '02', '03', '03', '03');


begin
  k := 0;

  i := 1;
  while i <= z_size do begin
    p := 1; inc(i);
    while z[i] = z[i - 1] do begin
      inc(p); inc(i);
    end;

    inc(k);
    x[k].code := z[i - 1];
    x[k].count := p;
  end;


  for i := 1 to k do begin
    writeln(x[i].code, ' : ', x[i].count);
  end;

end.

Идея понятна?

Добавлено через 1 мин.
А вообще-то, по-хорошему, тебе бы надо пересмотреть структуру программы...

Да, спасиб, всё ясно стало
Токо вот теоритически алгорит правельный, а считает не то почему-то...

Нажмите для просмотра прикрепленного файла - вот тут первый столбик - это рассчпечатка z[i].CodeOTD, а второй, ниже, там где через двоеточие, это сформировавшийся массив X. Как видно - считает почему-то не то....Не понимаю...

║
║  reset(osnov);
║  t:=filesize(osnov);
║  getmem(z,t*sizeof(Zap));
║  getmem(x,t*sizeof(HZ));
║  k:=0;
║  while not(eof(osnov)) do
║    begin
║      read(osnov,Zap);
║      inc(k);
║      z^[k]:=zap;
║    end;
║  close(osnov);
║  k:=0;
║  reset(osnov);
║  while not(eof(osnov)) do
║    begin
║      read(osnov,Zap);
║      inc(k);
║      x^[k]:=helpzap;
║    end;
║  close(osnov);
║  k:=0;
║  i:=1;
║  while i <= t do
║    begin
║      p:=1;
║      inc(i);
║      while z^[i].CodeOTD = z^[i-1].CodeOTD do
║        begin
║          inc(p);
║          inc(i);
║        end;
║      inc(k);
║      x^[k].CODEOTDELA:= z^[i-1].CodeOTD;
║      str(p,x^[k].TAB);
║    end;
║
║  For i:=1 to t do
║    writeln(z^[i].CodeOTD);
║  writeln;
║  For i:=1 to k do
║      writeln(x^[i].CODEOTDELA,'  :  ',x^[k].TAB);
║

Что не так-то?

Значится, так... Первое, что тебе надо было сделать (я совсем забыл тебе сказать) - это во всех структурах поменять простой string на string[255]... У меня, например, под FPC, это играет решающую роль - без этого не работает, а с изменением - на ура... Попробуй...

Только что заметил:

  For i:=1 to k do
      writeln(x^[i].CODEOTDELA,'  :  ',x^[i].TAB); { <--- Печатать i-ый элемент, а не всегда последний !!! }

Чувствуешь разницу?

Щет!!! ))
несколько дней искал в чём трабла, а тут даж не замечал
Надо завязывать с учёбой , даёшь выходные после завершения лабораторки

СПасиб тебе огромнейшее ))