|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Private dic As New Dictionary
- Private nowR As Long
- Sub 按钮4_Click()
- Randomize
- '清空数据区域
- Range("b2:d100").ClearContents
- Range("d2:d100").ClearContents
- Range("f2:f100").ClearContents
-
- '枚举所有可能答案
- dic.RemoveAll
- mkAnss dic
-
- '初始化
- nowR = 2
- GuessOne '猜一个
- End Sub
- Sub GuessOne()
- Dim n As Long
- Dim aa As Long, bb As Long, cc As Long, dd As Long, av As Long, bv As Long
-
- If nowR = 2 Then
- n = Int(Rnd * dic.Count)
- Cells(nowR, 3) = dic.Keys(n)
- nowR = nowR + 1
- Else
- n = Cells(nowR - 1, 3)
- av = Cells(nowR - 1, 4)
- bv = Cells(nowR - 1, 6)
- aa = n \ 1000
- bb = (n Mod 1000) \ 100
- cc = (n Mod 100) \ 10
- dd = n Mod 10
- For n = dic.Count - 1 To 0 Step -1
- If Not ckANS(CStr(dic.Keys(n)), aa, bb, cc, dd, av, bv) Then dic.Remove (dic.Keys(n))
- Next
- n = Int(Rnd * dic.Count)
- Cells(nowR, 3) = dic.Keys(n)
- nowR = nowR + 1
- End If
- End Sub
- Sub mkAnss(ByRef dic As Dictionary)
- Dim a As Long, b As Long, c As Long, d As Long
- For a = 1 To 9
- For b = 0 To 9
- If b <> a Then
- For c = 0 To 9
- If c <> a And c <> b Then
- For d = 0 To 9
- If d <> a And d <> b And d <> c Then
- dic.Add a * 1000 + b * 100 + c * 10 + d, 0
- End If
- Next
- End If
- Next
- End If
- Next
- Next
- End Sub
- Function ckANS(n As Long, aa As Long, bb As Long, cc As Long, dd As Long, av As Long, bv As Long) As Boolean
- Dim a As Long, b As Long, c As Long, d As Long
- a = n \ 1000
- b = (n Mod 1000) \ 100
- c = (n Mod 100) \ 10
- d = n Mod 10
- m = -((aa = a) + (bb = b) + (cc = c) + (dd = d))
- n = -((aa = b Or aa = c Or aa = d) + (bb = a Or bb = c Or bb = d) + (cc = a Or cc = b Or cc = d) + (dd = a Or dd = b Or dd = c))
- ckANS = (m = av And n = bv)
- End Function
复制代码
下面是电脑猜的一个过程
|
|