电脑猜数字xAyB

killq · 发表于 2019-6-26 14:11

killq 发表于 2019-6-26 13:40
好吧，既然玩暴力，那么我也出个吧，不完善，比如重复数字没有判断，再比如没有对不停的点“下一步”进行限 ...

有bug，少考虑了末位为更小值的情况，懒得加判断语句了，放弃

zopey · 发表于 2019-6-26 15:22

Moneky 发表于 2019-6-26 13:15
7楼附件使用说明：
点击 [重开] 开始新的游戏，电脑会随便猜一个数，然后你需要手动设置 ?A?B，设定好后， ...

mkAnss 过程，发现个笔误：a=1 to 9
For a = 0 To 9
For b = 0 To 9

Moneky · 发表于 2019-6-26 16:04

zopey 发表于 2019-6-26 15:22
mkAnss 过程，发现个笔误：a=1 to 9
For a = 0 To 9
For b = 0 To 9

首位不为零，且数字不重复。不是笔误。
最早发的代码中有个cstr应该为clng，这个才是笔误

zopey · 发表于 2019-6-26 17:09

8 楼附件上改的随机猜数，
遇到狡猾的狐狸一般要7 -8次。（次数偏多）

电脑猜数字2.zip (20.95 KB, 下载次数: 13)

zopey · 发表于 2019-6-30 11:10

完成作品, 请按步骤操作。第一个数字筛选计算较慢。

文曲星猜数字（辅助）.rar (150.46 KB, 下载次数: 10)

zopey · 发表于 2019-6-30 11:15

Sub 按钮8_Click()
Range("L2:AB9999").ClearContents
k0 = [j1].End(4).Row - 1
If k0 <= 1 Then Exit Sub
arr = [j2].Resize(k0, 1)
k = 0
ReDim brr(1 To 5040, 0 To 14)
dic.RemoveAll
For a = 0 To 6
For b = a + 1 To 7
For c = b + 1 To 8
For d = c + 1 To 9
s = a & b & c & d
Call dgQPL("", s, 4)
Next d, c, b, a
[l2].Resize(dic.Count, 2) = Application.Transpose(Array(dic.Keys, dic.Items))
[n2].Resize(5040, 15) = brr
[L1].Resize(5041, 17).Sort key1:=Range("M1"), order1:=xlAscending, Header:=xlGuess
MsgBox "建议：" & Format([l2], "0000")
[l2].Select
End Sub
Sub dgQPL(x, y, j)
Dim cr(0 To 14)
If j = 1 Then
k = k + 1
For m = 1 To k0
ts = compare(Format(arr(m, 1), "0000"), x & y)
cr(ts) = cr(ts) + 1
brr(k, ts) = brr(k, ts) + 1
Next
dic(x & y) = Application.Max(cr)
Else
For i = 1 To j
Call dgQPL(x & Mid(y, i, 1), Left(y, i - 1) & Right(y, j - i), j - 1)
Next
End If
End Sub
Function compare(a, b)
qa = 0: qb = 0
For i = 1 To 4
For j = 1 To 4
If Mid(a, i, 1) = Mid(b, j, 1) Then
If i = j Then qa = qa + 1 Else qb = qb + 1
Exit For
End If
Next
Next
If qa = 0 Or qa = 3 Then
compare = qa * 4 + qb
ElseIf qa = 1 Or qa = 2 Then
compare = qa * 4 + qb + 1
ElseIf qa = 4 Then
compare = 14
End If
End Function

复制代码

zopey · 发表于 2019-6-30 19:16

3A1B 是不符合逻辑的判断，实际不会发生。据此修正

猜数字辅助V2.0.rar (250.31 KB, 下载次数: 29)

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

[求助] 电脑猜数字xAyB