加了一点注释，还是不懂得话，可以密我 Dim a,b,c,d,j,i,jieguo jieguo="" For i=1000 To 9999 i=CStr(i) a=Int(Left(i,1)) b=Int(Mid(i,2,1)) c=Int(Mid(i,3,1)) d=Int(Right(i,1)) If ab And ac And ad Then If bc And bd Then If cd And InStr(i,0)=0 Then '保证四位乘数各位不相等并且各位均不为零 For j=1 To 9 s=i*j If s=1000 And InStr(i,j)=0 Then '保证得数是四位整数，并且各位与单位乘数无重复 Call yz(s) End if next End If End If End If Next MsgBox jieguo Function yz(n) n=CStr(n) e=Int(Left(n,1)) f=Int(Mid(n,2,1)) g=Int(Mid(n,3,1)) h=Int(Right(n,1)) If ef And eg And eh Then If fg And fh Then If gh And InStr(n,0)=0then If InStr(n,a)=0 And InStr(n,b)=0 and InStr(n,c)=0 And InStr(n,d)=0 And InStr(n,j)=0 Then '保证四位得数各位不相等并且各位均不为零，且四位乘数与四位得数各位均无重复 jieguo=jieguo & i & "*" & j & "=" & n & vbCrLf End If End If End If End If End Function 加了一点注释，还是不懂得话，可以密我 Dim a,b,c,d,j,i,jieguo jieguo="" For i=1000 To 9999 i=CStr(i) a=Int(Left(i,1)) b=Int(Mid(i,2,1)) c=Int(Mid(i,3,1)) d=Int(Right(i,1)) If ab And ac And ad Then If bc And bd Then If cd And InStr(i,0)=0 Then '保证四位乘数各位不相等并且各位均不为零 For j=1 To 9 s=i*j If s=1000 And InStr(i,j)=0 Then '保证得数是四位整数，并且各位与单位乘数无重复 Call yz(s) End if next End If End If End If Next MsgBox jieguo Function yz(n) n=CStr(n) e=Int(Left(n,1)) f=Int(Mid(n,2,1)) g=Int(Mid(n,3,1)) h=Int(Right(n,1)) If ef And eg And eh Then If fg And fh Then If gh And InStr(n,0)=0then If InStr(n,a)=0 And InStr(n,b)=0 and InStr(n,c)=0 And InStr(n,d)=0 And InStr(n,j)=0 Then '保证四位得数各位不相等并且各位均不为零，且四位乘数与四位得数各位均无重复 jieguo=jieguo & i & "*" & j & "=" & n & vbCrLf End If End If End If End If End Function