[已解决]VBA计算出所有可能算式用完1-9有2个乘2个最后一条

vbyou127

VBA计算出所有可能算式用完1-9有2个乘2个最后一条

最佳答案

月排行榜 / 总排行榜

grf1973

2016-4-20 16:43

1. Sub test6() 'ab*cd=ef*ghi /=11
   
2.     Dim a&, bcd&, e&, fghi&, k&, tms#
   
3.     [a:a] = ""
   
4.     tms = Timer
   
5.    
   
6.     For ab = 12 To 97
   
7.         For cd = ab + 1 To 98
   
8.             For ef = 12 To 98
   
9.                 If ab * cd Mod ef = 0 Then
   
10.                     ghi = ab * cd / ef
    
11.                     If Len(ab & cd & ef & ghi) = 9 Then
    
12.                         If Chk(ab & cd & ef & ghi) Then k = k + 1: Cells(k, 1) = ab & "*" & cd & "=" & ef & "*" & ghi
    
13.                     End If
    
14.                 End If
    
15.             Next
    
16.         Next
    
17.     Next
    
18.     MsgBox Format(Timer - tms, "0.000s ") & k
    
19. End Sub
    
20. Function Chk(s) As Boolean
    
21.     Dim i&
    
22.     If InStr(s, "0") Then Exit Function
    
23.     For i = 1 To Len(s) - 1
    
24.         If InStr(i + 1, s, Mid(s, i, 1)) Then Exit Function
    
25.     Next
    
26.     Chk = True
    
27. End Function
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub test6() 'ab*cd=ef*ghi /=11
   
2.     Dim a&, bcd&, e&, fghi&, k&, tms#
   
3.     [a:a] = ""
   
4.     tms = Timer
   
5.    
   
6.     For ab = 12 To 97
   
7.         For cd = ab + 1 To 98
   
8.             For ef = 12 To 98
   
9.                 If ab * cd Mod ef = 0 Then
   
10.                     ghi = ab * cd / ef
    
11.                     If Len(ab & cd & ef & ghi) = 9 Then
    
12.                         If Chk(ab & cd & ef & ghi) Then k = k + 1: Cells(k, 1) = ab & "*" & cd & "=" & ef & "*" & ghi
    
13.                     End If
    
14.                 End If
    
15.             Next
    
16.         Next
    
17.     Next
    
18.     MsgBox Format(Timer - tms, "0.000s ") & k
    
19. End Sub
    
20. Function Chk(s) As Boolean
    
21.     Dim i&
    
22.     If InStr(s, "0") Then Exit Function
    
23.     For i = 1 To Len(s) - 1
    
24.         If InStr(i + 1, s, Mid(s, i, 1)) Then Exit Function
    
25.     Next
    
26.     Chk = True
    
27. End Function
    

复制代码

vbyou127

Sub s()
Const a = "123456789"
For i = 1 To 9
b = Replace(a, i, "")
For j = 1 To 8
x = Mid(b, j, 1)
c = Replace(b, x, "")
xx = i * 10 + Val(x)
p c, xx, 1, 0
Next j, i
End Sub
Sub p(a, x, k, y)
For i = 1 To Len(a)
xx = Mid(a, i, 1)
yy = y * 10 + Val(xx)
b = Replace(a, xx, "")
Z = x * yy
If k = 2 And x < yy Then
For j = 1 To 5
xx1 = Mid(b, j, 1)
cc = Replace(b, xx1, "")
For jj = 1 To 4
xx2 = Mid(cc, jj, 1)
xx = xx1 * 10 + xx2
If Z Mod xx = 0 Then
zz = Z / xx
If zz < 1000 And zz > 100 Then
c = Replace(cc, xx2, "")
For jjj = 1 To 3
c = Replace(c, Mid(CStr(zz), jjj, 1), "")
Next
If c = "" Then
Debug.Print x; "X"; yy; "="; xx; " X"; zz
End If
End If
End If
Next jj, j
Else
p b, x, k + 1, yy
End If
Next
End Sub

grf1973

你这是来活跃气氛来了？

vbyou127

grf1973 发表于 2016-4-20 16:52
你这是来活跃气氛来了？

好多天没有来了