CLS
INPUT n
m=0
DIM a(20)
DO
  m=m+1:s=n*m
  ERASE a
  DO WHILE s>0
     i=i+1:a(i)=s MOD 10:s=s\10
  LOOP
  GOSUB 12345
LOOP UNTIL f=1
PRINT m
END
12345:
FOR j=1 TO i
    IF a(i)>=2 THEN f=0:RETURN
NEXT j
f=1
RETURN

嘿嘿,呵呵.

嘿嘿，呵呵，用字符串

cls
input n
do
m=m+1
s=n*m
s$=str$(s)
ls=len(s$)
x=-1
for i=2 to ls
t=val(mid$(s$,i,1))
if t>2 then x=0:exit for
next i
loop until x=-1
print m
end
[fly]可能会错[/fly]

DefLng A-Z
Function S0101(x)
Dim r(1000),r2(1000)
a = Int(x)
Do While a Mod 10 = 0
   a = a \ 10
Loop
m = 1
mm = 0
o = 0
k = 1
kk = 1
kkk = 10
j = 10
jj = 100
Select Case a Mod 10
Case 1: r(1) = 1
Case 2: r(1) = 5
Case 3: r(1) = 7
Case 4: r(1) = 5
Case 5
        r(1) = 2
        r(2) = 4
        r(3) = 6
        r(4) = 8
        m = 4
Case 6: r(1) = 5
Case 7: r(1) = 3
Case 8: r(1) = 5
Case 9: r(1) = 9
End Select

Do
   For n = 1 To m
       i = r(n) + o
       y = S01(i * a)
       Select Case y
       Case -1: Exit Do
       Case Is >= k
            mm = mm + 1
            r2(mm) = i
       End Select
   Next
   If o = 0 Then o = 10 Else o = o + kk
   If o = kkk Then
      k = k + 1
      kk = kkk
      kkk = kkk * 10
      m = mm
      mm = 0
      For nn=1 to m
          r(nn)=r2(nn)
      Next
   End If
Loop
S0101 = i
End Function

Function S01(x)
s$ = LTrim$(Str$(x))
L = Len(s$)
For i = 1 To L
    If Mid$(s$, L - i + 1, 1) > "1" Then Exit For
Next
If i > L Then S01 = -1 Else S01 = i - 1
End Function

当乘积溢出长整型时出错。
唉，原来想一次不用字符串的，看来还是行不通。

把楼上的第一行改成  defcur......


这里的也就改了一下,可惜的是我的确不能掌握规律,计算范围不能太大.

DECLARE FUNCTION S0101$ (e10&)
DECLARE FUNCTION S01& (a$)
DECLARE FUNCTION add$ (a$, b$)
DECLARE FUNCTION X$ (a$, b$)
PRINT S0101$(246832)

FUNCTION add$ (a$, b$)
a$ = LTRIM$(RTRIM$(a$))
b$ = LTRIM$(RTRIM$(b$))
la% = LEN(a$)
lb% = LEN(b$)
IF la% > lb% THEN lc% = la% + 15 ELSE lc% = lb% + 15
a$ = RIGHT$(SPACE$(lc% - la%) + a$, lc%)
b$ = RIGHT$(SPACE$(lc% - la%) + b$, lc%)
c$ = SPACE$(lc%)
FOR i% = lc% TO 1 STEP -14
    z@ = VAL(MID$(a$, i%, 14)) + VAL(MID$(b$, i%, 14)) + z@
    MID$(c$, i%, 14) = RIGHT$(SPACE$(14) + STR$(z@), 14)
    z@ = FIX(z@ / 100000000000000@)
NEXT
add$ = LTRIM$(RTRIM$(c$))
END FUNCTION

FUNCTION S01& (a$)
s$ = LTRIM$(RTRIM$(a$))
L& = LEN(s$)
FOR i& = 1 TO L&
    IF MID$(s$, L& - i& + 1, 1) > "1" THEN EXIT FOR
NEXT
IF i& > L& THEN S01& = -1 ELSE S01& = i& - 1
END FUNCTION

DEFLNG A-Z
FUNCTION S0101$ (e10)
a = INT(e10)
DO WHILE a MOD 10 = 0
   L10 = L10 + 1
   a = a \ 10
LOOP
b$ = MID$("157525359", a MOD 10, 1) + ","
IF a MOD 10 = 5 THEN b$ = "2,4,6,8,"
a2$ = LTRIM$(STR$(a))

   i = 1
   j = 1
   i = INSTR(i, b$, ",")
   DO WHILE i
      a3$ = LTRIM$(STR$(o@ + VAL(MID$(b$, j, i - j))))
      y$ = X$(a3$, a2$)
      IF S01(y$) = -1 THEN
         S0101$ = a2$ + " x" + a3$ + " = " + y$
         EXIT FUNCTION
      END IF
      j = i + 1
      i = INSTR(j, b$, ",")
   LOOP

k = 1
kk@ = 10
DO
   FOR oo@ = 0 TO 9
   o@ = oo@ * kk@
   i = 1
   j = 1
   i = INSTR(i, b$, ",")
   DO WHILE i
      a3$ = LTRIM$(STR$(o@ + VAL(MID$(b$, j, i - j))))
      y$ = X$(a3$, a2$)
      SELECT CASE S01(y$)
      CASE -1
         S0101$ = STR$(e10) + " x " + a3$ + " = " + y$ + STRING$(L10, 48)
         EXIT FUNCTION
      CASE IS >= k
         c$ = c$ + a3$ + ","
      END SELECT
      j = i + 1
      i = INSTR(j, b$, ",")
   LOOP
   NEXT
   kk@ = kk@ * 10
   k = k + 1
   b$ = c$
   c$ = ""
LOOP
END FUNCTION

FUNCTION X$ (a$, b$)
  a$ = LTRIM$(RTRIM$(a$))
  b$ = LTRIM$(RTRIM$(b$))
  la = LEN(a$)
  lb = LEN(b$)
  lc = la + lb
  IF lc < 15 THEN
     xx1@ = VAL(a$)
     xx2@ = VAL(b$)
     X$ = LTRIM$(STR$(FIX(xx1@ * xx2@)))
     EXIT FUNCTION
  END IF
  s$ = " " + STRING$(lc - 1, 48)'SPACE$(lc)
  FOR i = ((la - 1) \ 13) * 13 + 1 TO 1 STEP -13
    a2@ = VAL(MID$(a$, i, 13))
    IF i + 12 > la THEN wa = la ELSE wa = i + 12
    z@ = 0
    FOR j = lb TO 1 STEP -1
      w = wa + j
      z@ = a2@ * VAL(MID$(b$, j, 1)) + VAL(MID$(s$, w, 1)) + z@
      z2@ = FIX(z@ / 10)
      MID$(s$, w, 1) = CHR$(48 + (z@ - z2@ * 10))
      z@ = z2@
    NEXT
    z@ = z@ + VAL(LEFT$(s$, w - 1))
    z3$ = LTRIM$(STR$(z@))
    MID$(s$, w - LEN(z3$)) = z3$
  NEXT i
  X$ = LTRIM$(s$)
END FUNCTION

declare function s0101$(n@)
declare function s010s@(a$)
defcur a-z
do
   input n
   if n=0 then exit do
   print s0101(n)
loop

function s0101$(n)
dim r1$(8000),r2(8000)
a=n
do
   b=fix(n/10)
   if a-10*b=0 then a=b else exit do
   l10%=l10%+1
loop

i=1
j1%=1
j2%=1
do
  for i=i to 9
      ia=i*a
      for j%=j1% to j2%
          z1=ia+r2(j%)
          z2=z1
          z3=fix(z1/10)
          if z2-10*z3<2 then
             j0$=chr$(48+i)+r1$(j%)
             if s010s(ltrim$(str$(z1)))then
                s0101$=j0$
                exit function
             end if
             m%=m%+1
             j3%=4001-j1%+m%
             r1$(j3%)=j0$
             r2(j3%)=z3
          end if
      next
  next
  j1%=4002-j1%
  j2%=j1%+m%-1
  m%=0
  i=0
loop
s0101$=j$
end function

function s010s(a$)
for i=1 to len(a$)
    if mid$(a$,i,1)>"1" then exit function
next
s010s=-1
end function

输入 687468, 字符串空间耗尽，
看样子，我离疯子不远矣。