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

vbyou127 · 发表于 2016-5-4 09:14

VBA编写数字等式2

最佳答案

月排行榜 / 总排行榜

grf1973

2016-5-4 09:55

共146组

Sub test5()
Dim a%(1 To 7), k&, n&, s, tms#
[a:a] = ""
tms = Timer
For k = 1234567 To 9876543
If Chk(k) Then
For i = 1 To 7: a(i) = Val(Mid(k, i, 1)): Next
s = a(1) ^ a(2) + (a(3) * 10 + a(4)) / a(5) - a(6) * a(7)
If s > 0 And Len(s) = 2 Then
If Chk(s & k) Then
n = n + 1
Cells(n, 1) = a(1) & "^" & a(2) & "+" & a(3) & a(4) & "/" & a(5) & "-" & a(6) & "*" & a(7) & "=" & s
End If
End If
End If
Next
MsgBox Format(Timer - tms, "0.000s ") & n
End Sub
Function Chk(s) As Boolean
Dim i&
If InStr(s, "0") Then Exit Function
For i = 1 To Len(s) - 1
If InStr(i + 1, s, Mid(s, i, 1)) Then Exit Function
Next
Chk = True
End Function

复制代码

跳转到最佳答案楼层

grf1973 · 发表于 2016-5-4 09:55

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

共146组

Sub test5()
Dim a%(1 To 7), k&, n&, s, tms#
[a:a] = ""
tms = Timer
For k = 1234567 To 9876543
If Chk(k) Then
For i = 1 To 7: a(i) = Val(Mid(k, i, 1)): Next
s = a(1) ^ a(2) + (a(3) * 10 + a(4)) / a(5) - a(6) * a(7)
If s > 0 And Len(s) = 2 Then
If Chk(s & k) Then
n = n + 1
Cells(n, 1) = a(1) & "^" & a(2) & "+" & a(3) & a(4) & "/" & a(5) & "-" & a(6) & "*" & a(7) & "=" & s
End If
End If
End If
Next
MsgBox Format(Timer - tms, "0.000s ") & n
End Sub
Function Chk(s) As Boolean
Dim i&
If InStr(s, "0") Then Exit Function
For i = 1 To Len(s) - 1
If InStr(i + 1, s, Mid(s, i, 1)) Then Exit Function
Next
Chk = True
End Function

复制代码

lichuanboy44 · 发表于 2016-5-4 11:18

本帖最后由 lichuanboy44 于 2016-5-4 11:46 编辑

2楼算1-9数字加减乘除乘方运算的通用程序了，楼主如果再变个算式，仍可用这个程序。
只是运行时间25秒左右，不过还是可接受的，毕竟是通用公式。
另外，我尝试加了个限制条件，速度也没提高多少，即乘方的结果必须小于等于3位数，除法必须整除
         s = a(1) ^ a(2) + (a(3) * 10 + a(4)) / a(5) - a(6) * a(7)
         s1 = a(1) ^ a(2): s2 = (a(3) * 10 + a(4)) / a(5)
         If Len(s1) <= 3 Or Int(s2) = s2 Then 'If Len(s1)
此题想提速，估计要从减少for循环次数入手，但代码语句较多，看起繁杂一起。
1、先找限制条件，如果有除法，除法首先，只必须整除。如果没有除法运算，再找乘方，将符合条件的先存入一数组
2、楼上通用公式for从1234567 到9876543，循环了8641976，即864万多次。如果除法运算的3个数排除后，余下的则只用4个位数用楼上通用公式验算了，即从经类似贴子验算，两位数除以一位数，符合条件的有144个，故需两个for循环，大意如下：
for 1 to 144 '依次取出符合条件的除法运算的三位数
      for 1234 to 9876 ‘验算其它4个数
         ****
      next
next
以上总运算次数为144*（9876-1234）=124万，远小于864万。
不过，如果综合算式中全是加减乘，则只有用通用公式了。
总之，先用最大的限制条件运算一次，将符合条件的结果存入一数组，再用楼上通用公式验算余下的几位数。
写完，自己就觉得好啰嗦，不过，本人打字速度较快，每分钟50个左右，算是学习的愉快收获了。

grf1973 · 发表于 2016-5-4 11:37

你的什么电脑，我运行9秒。

lichuanboy44 · 发表于 2016-5-4 11:51

本帖最后由 lichuanboy44 于 2016-5-4 11:56 编辑

grf1973 发表于 2016-5-4 11:37
你的什么电脑，我运行9秒。

这次快一点，我的电脑不新不旧的。能达到这速度，真的很不错。

grf1973 · 发表于 2016-5-4 13:32

先把345两位数/一位数的分离出来，剩下的全搜索，会快很多。

Sub test5()
Dim k&, n&, s, tms#
[a:a] = ""
tms = Timer
For x345 = 123 To 987
If Chk(x345) Then
x34 = x345 \ 10: x5 = x345 Mod 10
If x34 Mod x5 = 0 Then
For k = 1234 To 9876
If Chk(k & x345) Then
x1 = Val(Left(k, 1)): x2 = Val(Mid(k, 2, 1))
x6 = Val(Mid(k, 3, 1)): x7 = Val(Mid(k, 4, 1))
s = x1 ^ x2 + x34 / x5 - x6 * x7
If s > 0 And Len(s) = 2 Then
If Chk(s & k & x345) Then
n = n + 1
Cells(n, 1) = x1 & "^" & x2 & "+" & x34 & "/" & x5 & "-" & x6 & "*" & x7 & "=" & s
End If
End If
End If
Next
End If
End If
Next
MsgBox Format(Timer - tms, "0.000s ") & n
End Sub
Function Chk(s) As Boolean
Dim i&
If InStr(s, "0") Then Exit Function
For i = 1 To Len(s) - 1
If InStr(i + 1, s, Mid(s, i, 1)) Then Exit Function
Next
Chk = True
End Function

复制代码

鼻涕可长了 · 发表于 2016-5-4 15:08

1111

鼻涕可长了 · 发表于 2016-5-4 15:10

grf1973 发表于 2016-5-4 13:32
先把345两位数/一位数的分离出来，剩下的全搜索，会快很多。

爱疯 · 发表于 2016-5-4 15:34

参考：http://www.excelpx.com/thread-305534-1-1.html

建议：在问题解决以后，最好修改一下主题分类。

		自动登录	找回密码
密码			注册

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

评分

评分