program meiju;
const mb=[1..9];
var i,bj,bk:integer;
    sz:set of 1..9;
begin
  for i:=123 to 332 do
  begin
    bj:=i*2;
    bk:=i*3;
    sz:=[];
    sz:=sz+[(i div 100)]+[(i mod 10)]+[(i div 10-((i div 100)*10))]+
        [(bj div 100)]+[(bj mod 10)]+[(bj div 10-((bj div 100)*10))]+
        [(bk div 100)]+[(bk mod 10)]+[(bk div 10-((bk div 100)*10))];
    if sz=mb then writeln(i,' ',bj,' ',bk);
  end;
end.

TYPE arr = ARRAY[1..9] OF INTEGER;
VAR
   a: arr;
PROCEDURE fj(s1, s2, s3: INTEGER);
BEGIN
    a[1] := s1 DIV 100; a[2] := (s1 - a[1] * 100) DIV 10; a[3] := s1 MOD 10;
    a[4] := s2 DIV 100; a[5] := (s2 - a[4] * 100) DIV 10; a[6] := s2 MOD 10;
    a[7] := s3 DIV 100; a[8] := (s3 - a[7] * 100) DIV 10; a[9] := s3 MOD 10;
END;
VAR
   i, j, k, s1, l: INTEGER; s2: LONGINT;
BEGIN
    FOR i:=123 TO 332 DO BEGIN
        j := i * 2; k := i * 3;
        fj(i, j, k);
        s1 := 0; s2 := 1;
        FOR l:=1 TO 9 DO BEGIN
            s1 := s1 + a[l];
            s2 := s2 * a[l];
        END;
        IF (s1 = 45) AND (s2 = 362880) THEN WRITELN(i, ' ', j, ' ', k);
    END;
END.

我看了abcwuhang和Matodied的程序了,就一个地方没懂:[color=000080]为什么for是从123到332的?[/color]
  还有就是我认为abcwuhang的程序中
  sz:=[color=00FF00]sz[/color]+[(i div 100)]+[(i mod 10)]+[(i div 10-((i div 100)*10))]+
     [(bj div 100)]+[(bj mod 10)]+[(bj div 10-((bj div 100)*10))]+
     [(bk div 100)]+[(bk mod 10)]+[(bk div 10-((bk div 100)*10))];
  [color=00FF00]sz[/color]没有必要.
  我个人觉得abcwuhang的程序要容易理解一点,而且abcwuhang的程序的时间复杂度为W(n),Matodied的程序的时间复杂度为W(n^2).谢谢两位!![em2]

准确来说应该是从100到333的。因为这个i乘以3的积一定是3位数，要是超过了333，乘积就变成4位数了。

但是100到122中的每个数以及333和它们乘以2、3的积一定有0或重复的数字，所以可以排除。

至于我的程序里内循环可能有点难懂，我说一下意思：

检测n个数是不是和集合[a1,a2,……an]中的数相等（位置可不想等）只要判断着n个数的和以及积是不是和集合中数的和以及积相等就可以了。

其实我觉得从123 to 329 就可以了,因为329以后都有重复的数字,你觉得呢?

可以,因为这样更能节省时间,但人为判断因素更多了.
PS:3楼:我的程序中的那个"sz"是可以省略,多谢 怜丹欣 提醒!

program ex;
function cshu(j:integer):integer;
begin
  cshu:=0;
  repeat
    begin
      cshu:=j mod 10+cshu;
      j:=j div 10;
    end;
  until j=0;
end;
function chshu(j:integer):longint;
begin
  chshu:=1;
  repeat
    begin
      chshu:=(j mod 10)*chshu;
      j:=j div 10;
    end;
  until j=0;
end;
procedure main;
var x,xxx,xx:longint;
    i,j,k:1..9;
begin
  for i:=1 to 3 do
    begin
      for j:=1 to 9 do if i<>j then
        begin
          for k:=1 to 9 do if(k<>i)and(k<>j)then
            begin
              x:=i*100+j*10+k;
              xx:=2*x;
              xxx:=x*3;
              if((i+j+k)+cshu(xx)+cshu(xxx)=45)and
              (i*j*k*chshu(xx)*chshu(xxx)=362880) then
              writeln(x,' ',xx,' ',xxx,' ');
            end;
        end;
    end;
end;
begin
  main;
end.
小弟报到,要讲解吗??
要在8..10楼回帖.

var i,b,c,j,k,f:integer;x,y,z:string;
begin
FOR i:=123 TO 329 do
begin
  b:=i*2;c:=i*3;f:=1;
  str(i,x);STR(b,y);STR(c,z);x:=x+y+z;
  FOR j:=2 TO 9 do
  FOR k:=1 TO j-1 do
    IF (copy(x,j,1)=copy(x,k,1)) OR (copy(x,k,1)='0') THEN 
    begin
      f:=0;break;
    end;
  if f=1 then writeln(i,' ',b,' ',c)
end;
end.
这样不就行了.