[已解决]VBA编写数字等式3

vbyou127

VBA编写数字等式3

最佳答案

月排行榜 / 总排行榜

grf1973

2016-5-4 13:44

万能解法。10组。

1. Sub test5()
   
2.     Dim k&, n&, s, tms#
   
3.     [a:a] = ""
   
4.     tms = Timer
   
5.     For x5 = 2 To 9
   
6.         For x6 = 1 To x5 - 1
   
7.             If x5 Mod x6 = 0 Then
   
8.                 For k = 1234 To 9876
   
9.                     If Chk(k & x5 & x6) Then
   
10.                         x1 = Val(Left(k, 1)): x2 = Val(Mid(k, 2, 1))
    
11.                         x3 = Val(Mid(k, 3, 1)): x4 = Val(Mid(k, 4, 1))
    
12.                         s = x1 ^ x2 - x3 * x4 + x5 / x6
    
13.                         If s > 0 And Len(s) = 3 Then
    
14.                             If Chk(s & k & x5 & x6) Then
    
15.                                 n = n + 1
    
16.                                 Cells(n, 1) = x1 & "^" & x2 & "-" & x3 & "*" & x4 & "+" & x5 & "/" & x6 & "=" & s
    
17.                             End If
    
18.                         End If
    
19.                     End If
    
20.                 Next
    
21.             End If
    
22.         Next
    
23.     Next
    
24.     MsgBox Format(Timer - tms, "0.000s ") & n
    
25. End Sub
    
26. Function Chk(s) As Boolean
    
27.     Dim i&
    
28.     If InStr(s, "0") Then Exit Function
    
29.     For i = 1 To Len(s) - 1
    
30.         If InStr(i + 1, s, Mid(s, i, 1)) Then Exit Function
    
31.     Next
    
32.     Chk = True
    
33. End Function
    

复制代码

跳转到最佳答案楼层

grf1973

万能解法。10组。

1. Sub test5()
   
2.     Dim k&, n&, s, tms#
   
3.     [a:a] = ""
   
4.     tms = Timer
   
5.     For x5 = 2 To 9
   
6.         For x6 = 1 To x5 - 1
   
7.             If x5 Mod x6 = 0 Then
   
8.                 For k = 1234 To 9876
   
9.                     If Chk(k & x5 & x6) Then
   
10.                         x1 = Val(Left(k, 1)): x2 = Val(Mid(k, 2, 1))
    
11.                         x3 = Val(Mid(k, 3, 1)): x4 = Val(Mid(k, 4, 1))
    
12.                         s = x1 ^ x2 - x3 * x4 + x5 / x6
    
13.                         If s > 0 And Len(s) = 3 Then
    
14.                             If Chk(s & k & x5 & x6) Then
    
15.                                 n = n + 1
    
16.                                 Cells(n, 1) = x1 & "^" & x2 & "-" & x3 & "*" & x4 & "+" & x5 & "/" & x6 & "=" & s
    
17.                             End If
    
18.                         End If
    
19.                     End If
    
20.                 Next
    
21.             End If
    
22.         Next
    
23.     Next
    
24.     MsgBox Format(Timer - tms, "0.000s ") & n
    
25. End Sub
    
26. Function Chk(s) As Boolean
    
27.     Dim i&
    
28.     If InStr(s, "0") Then Exit Function
    
29.     For i = 1 To Len(s) - 1
    
30.         If InStr(i + 1, s, Mid(s, i, 1)) Then Exit Function
    
31.     Next
    
32.     Chk = True
    
33. End Function
    

复制代码

鼻涕可长了

grf1973 发表于 2016-5-4 13:44
万能解法。10组。

爱疯

建议修改主题分类