Вот написал программу которая находит такие числа на отрезке [2,n] что сумма их цифр не изменится при умножение числа на (число - a)
Тестовые значения n=100,a=1
По идеи должен вывести все числа от 2 до 100, так как сумма их цифр не изменится при умножение на 1...но почему то выдаёт 2,9 (((
Ещё незнаю куда сунуть вот это zp2:=s1*a; так как если внутрь цикла ставить то каждый раз будет умножаться сумма на число (а)

Program otrezok;
Var n,a,i,s1,s2,zp1,zp2,k:integer;
Begin
    write('Введите число N ');readln(n);
    write('Введите число A ');readln(a);
    s1:=0;s2:=0;
    For i:=2 to n do
    Begin
    zp1:=i;
    While zp1<>0 do
    Begin
    s1:=s1+(zp1 mod 10);
    zp1:=zp1 div 10;
    zp2:=s1*a;
    end;
    While zp2<>0 do
    Begin
    s2:=s2+(zp2 mod 10);
    zp2:=zp2 div 10;
    if s1=s2 then begin write(i, ',');k:=k+1;end;
    end;
    End;
    writeln('Всего таких чисел= ',k);
    readln;
End.

У тебя перемешаны строчки. Что-то надо внести внутрь цикла, что-то - наоборот, вынести из цикла.

Смотри:

   for i := 2 to n do
   begin
      s1 := 0; s2 := 0; { <--- !!! Суммы для каждого i свои, поэтому обнулять их надо здесь }
      zp1 := i;
      while zp1 <> 0 do
      begin
         s1 := s1 + (zp1 mod 10);
         zp1 := zp1 div 10;
      end; { Всё, цикл этим закончился, находить zp2 внутри цикла не надо }

      zp2 := s1*a;
      while zp2 <> 0 do
      begin
         s2 := s2 + (zp2 mod 10);
         zp2 := zp2 div 10;
      end; { Точно так же, как и здесь, проверка равенства - ПОСЛЕ цикла }

      if s1 = s2 then
      begin
         write(i, ','); k := k + 1;
      end;
    end;

(обнулять k перед началом основного цикла не забывай).

А вообще - у меня зародилось сомнение, что ты делаешь не то, что тебе надо. Задача в чем? Проверить, одинакова ли сумма цифр чисел I и I*A? Тогда zp2 := i*a, при чем тут умножение СУММЫ на A?

Чуток переписал но терь выводит 54 числа вместо 99

Program otrezok;
Var n,a,i,s1,s2,zp1,zp2,k:integer;
Begin
    write('Введите число N ');readln(n);
    write('Введите число A ');readln(a);
    For i:=2 to n do
    Begin
    zp1:=i;
    s1:=0;s2:=0;
    While zp1<>0 do
    Begin
    s1:=s1+(zp1 mod 10);
    zp1:=zp1 div 10;
    zp2:=s1*a;
    end;
    While zp2<>0 do
    Begin
    s2:=s2+(zp2 mod 10);
    zp2:=zp2 div 10;
    if s1=s2 then begin write(i, ',');k:=k+1;end;
    end;
    End;
    writeln('Всего таких чисел= ',k);
    readln;
End.

Добавлено через 6 мин.


Воо спасибо ошибка была именно в этом,что то когда писал запутался))))

Соблюдал бы отступы, не запутался бы.