EXCEL VBA 宏 数独游戏解法 回溯
1、将数独的已知数填入活动表的A1：I9单元格，打开宏编辑器，将如下语句考入编辑区。运行宏即可
2、Sub 数独()
'本程序有很多不足，欢迎改进！
Dim i As Byte, t As Byte, r As Byte, x As Byte, y As Byte, zz As Integer
Dim ta As Byte，tc As Double
Dim hh(1 To 9, 1 To 9, 1 To 9) As Byte '用于保存每个单元格中可能的数，经过排序最后一维保存的数从大到小，一维、二维是单元格的位置
Dim g(1 To 9, 1 To 9) As Byte, gg(1 To 9) As Byte '九宫和九宫的和
Dim ypsi(1 To 9, 1 To 9) As Byte, yskn(0 To 99999, 1 To 9, 1 To 9) As Byte '原始数组和分叉时保存数据的数组 0是起始数,原始可能的数。
Dim jisu(1 To 9, 1 To 9) As Byte '计数数组，由于统计每个单元格可能数字的个数，及数组hh(y,x,i)中i保留了几位数
Dim zsjw(1 To 9) As Byte '中间数组
Dim dzan(0 To 99999, 1 To 6) As Integer '记录路径，候选数，历遍标志
MsgBox "根据游戏的难易程度有可能等待几秒到几十分钟，请耐心等待！ 点击 “确认” 开始"
Application.ScreenUpdating = False '关闭屏幕刷新
For y = 1 To 9
For x = 1 To 9
ypsi(y, x) = Cells(y, x) '把原始数据保留到数组
Next
Next
yskn(0, 1, 1) = 0
zz = 0
ta = 0
E1:
For y = 1 To 9
For x = 1 To 9
If Cells(y, x) = 0 Then Cells(y, x) = "" '如果单元格中有0 数组将溢出，此处做技术处理
Next
Next
g(1, 1) = Cells(1, 1) '把单元格的数转换到“宫”里以便编程
g(1, 2) = Cells(1, 2)
g(1, 3) = Cells(1, 3) '此处可以用取整函数，EVEN(y/3)来确定单元格属于哪一宫，但会增加运算次数。
g(1, 4) = Cells(2, 1)
g(1, 5) = Cells(2, 2)
g(1, 6) = Cells(2, 3)
g(1, 7) = Cells(3, 1)
g(1, 8) = Cells(3, 2)
g(1, 9) = Cells(3, 3)
g(2, 1) = Cells(1, 4)
g(2, 2) = Cells(1, 5)
g(2, 3) = Cells(1, 6)
g(2, 4) = Cells(2, 4)
g(2, 5) = Cells(2, 5)
g(2, 6) = Cells(2, 6)
g(2, 7) = Cells(3, 4)
g(2, 8) = Cells(3, 5)
g(2, 9) = Cells(3, 6)
g(3, 1) = Cells(1, 7)
g(3, 2) = Cells(1, 8)
g(3, 3) = Cells(1, 9)
g(3, 4) = Cells(2, 7)
g(3, 5) = Cells(2, 8)
g(3, 6) = Cells(2, 9)
g(3, 7) = Cells(3, 7)
g(3, 8) = Cells(3, 8)
g(3, 9) = Cells(3, 9)
g(4, 1) = Cells(4, 1)
g(4, 2) = Cells(4, 2)
g(4, 3) = Cells(4, 3)
g(4, 4) = Cells(5, 1)
g(4, 5) = Cells(5, 2)
g(4, 6) = Cells(5, 3)
g(4, 7) = Cells(6, 1)
g(4, 8) = Cells(6, 2)
g(4, 9) = Cells(6, 3)
g(5, 1) = Cells(4, 4)
g(5, 2) = Cells(4, 5)
g(5, 3) = Cells(4, 6)
g(5, 4) = Cells(5, 4)
g(5, 5) = Cells(5, 5)
g(5, 6) = Cells(5, 6)
g(5, 7) = Cells(6, 4)
g(5, 8) = Cells(6, 5)
g(5, 9) = Cells(6, 6)
g(6, 1) = Cells(4, 7)
g(6, 2) = Cells(4, 8)
g(6, 3) = Cells(4, 9)
g(6, 4) = Cells(5, 7)
g(6, 5) = Cells(5, 8)
g(6, 6) = Cells(5, 9)
g(6, 7) = Cells(6, 7)
g(6, 8) = Cells(6, 8)
g(6, 9) = Cells(6, 9)
g(7, 1) = Cells(7, 1)
g(7, 2) = Cells(7, 2)
g(7, 3) = Cells(7, 3)
g(7, 4) = Cells(8, 1)
g(7, 5) = Cells(8, 2)
g(7, 6) = Cells(8, 3)
g(7, 7) = Cells(9, 1)
g(7, 8) = Cells(9, 2)
g(7, 9) = Cells(9, 3)
g(8, 1) = Cells(7, 4)
g(8, 2) = Cells(7, 5)
g(8, 3) = Cells(7, 6)
g(8, 4) = Cells(8, 4)
g(8, 5) = Cells(8, 5)
g(8, 6) = Cells(8, 6)
g(8, 7) = Cells(9, 4)
g(8, 8) = Cells(9, 5)
g(8, 9) = Cells(9, 6)
g(9, 1) = Cells(7, 7)
g(9, 2) = Cells(7, 8)
g(9, 3) = Cells(7, 9)
g(9, 4) = Cells(8, 7)
g(9, 5) = Cells(8, 8)
g(9, 6) = Cells(8, 9)
g(9, 7) = Cells(9, 7)
g(9, 8) = Cells(9, 8)
g(9, 9) = Cells(9, 9)
For y = 1 To 9
'gg(y) = 0
For i = 1 To 9
jisu(y, i) = 0 '对计数数组赋值
'gg(y) = gg(y) + g(y, i) '对每一宫的数进行合计
For t = 1 To 9
hh(y, i, t) = t
Next
Next
Next
'''分段3
For y = 1 To 9
For x = 1 To 9
If Cells(y, x) > 0 And Cells(y, x) < 10 Then '如果宫格里的数已经确定则将该数读入列
For i = 1 To 9
hh(y, x, i) = 0
Next
Else
For i = 1 To 9
If Cells(y, i) <> "" Or Cells(y, i) <> 0 Then
r = Cells(y, i) '去掉行里有的数
hh(y, x, r) = 0
End If
Next
For t = 1 To 9
If Cells(t, x) <> "" Or Cells(t, x) <> 0 Then
r = Cells(t, x) '去掉列里有的数
hh(y, x, r) = 0
End If
Next
If y = 1 Or y = 2 Or y = 3 Then ''A
If x = 1 Or x = 2 Or x = 3 Then
For t = 1 To 9 '去掉宫1里有的数
If g(1, t) <> 0 Then
r = g(1, t)
hh(y, x, r) = 0
End If
Next
Else
If x = 4 Or x = 5 Or x = 6 Then
For t = 1 To 9 '去掉宫2里有的数
If g(2, t) <> 0 Then
r = g(2, t)
hh(y, x, r) = 0
End If
Next
Else
For t = 1 To 9 '去掉宫3里有的数
If g(3, t) <> 0 Then
r = g(3, t)
hh(y, x, r) = 0
End If
Next
End If
End If
'''''''''''''
Else ''1
If y = 4 Or y = 5 Or y = 6 Then
If x = 1 Or x = 2 Or x = 3 Then ''''3
For t = 1 To 9 '去掉宫4里有的数
If g(4, t) <> 0 Then
r = g(4, t)
hh(y, x, r) = 0
End If
Next
Else
If x = 4 Or x = 5 Or x = 6 Then
For t = 1 To 9 '去掉宫5里有的数
If g(5, t) <> 0 Then
r = g(5, t)
hh(y, x, r) = 0
End If
Next
Else
For t = 1 To 9 '去掉宫6里有的数
If g(6, t) <> 0 Then
r = g(6, t)
hh(y, x, r) = 0
End If
Next
End If
End If ''''3
Else
If y = 7 Or y = 8 Or y = 9 Then
If x = 1 Or x = 2 Or x = 3 Then ''''3
For t = 1 To 9 '去掉宫7里有的数
If g(7, t) <> 0 Then
r = g(7, t)
hh(y, x, r) = 0
End If
Next
Else
If x = 4 Or x = 5 Or x = 6 Then
For t = 1 To 9 '去掉宫8里有的数
If g(8, t) <> 0 Then
r = g(8, t)
hh(y, x, r) = 0
End If
Next
Else
For t = 1 To 9 '去掉宫9里有的数
If g(9, t) <> 0 Then
r = g(9, t)
hh(y, x, r) = 0
End If
Next
End If
End If
End If ''''3
End If '''1
End If ''A
End If
For i = 1 To 9
If hh(y, x, i) <> 0 Then '对单元格（数组）可能的数字进行计数
jisu(y, x) = jisu(y, x) + 1
End If
Next
Next
Next
'''''''对可能的数进行从大到小的排序
For y = 1 To 9
For x = 1 To 9
For i = 1 To 9
zsjw(i) = hh(y, x, i)
Next
For i = 1 To 9
hh(y, x, i) = Application.WorksheetFunction.Large(zsjw, i) '降序排序函数 和升序 small一样
Next
Next
Next
'''''''排序结束
''''''对走不通的单元格进行判断
For y = 1 To 9
For x = 1 To 9
If Cells(y, x) = "" And jisu(y, x) = 0 Then '死路的条件
For tc = 1 To zz '''''''用负步长此处溢出，采取技术处理，有可能是VBA的bag
If dzan(zz - tc, 1) = 2 Or dzan(zz - tc, 1) = 3 Then '判断有2个候选数和有3个候选数
If dzan(zz - tc, 1) = 2 Then
dzan(zz - tc, 1) = 1
For i = 1 To 9
For t = 1 To 9
Cells(i, t) = yskn(zz - tc, i, t)
Next
Next
Cells(dzan(zz - tc, 2), dzan(zz - tc, 3)) = dzan(zz - tc, 5)
GoTo E1
End If
If dzan(zz - tc, 1) = 3 Then ''有3个候选数选第3个再试
dzan(zz - tc, 1) = 2
For i = 1 To 9
For t = 1 To 9
Cells(i, t) = yskn(zz - tc, i, t)
Next
Next
Cells(dzan(zz - tc, 2), dzan(zz - tc, 3)) = dzan(zz - tc, 6)
GoTo E1
End If
End If
Next tc
End If
Next
Next
''''''判断结束
'''''''''''注释1，jisu数组中只有一个数（0除外）时，将相应的数写入相应的单元格并从头再来
For y = 1 To 9
For x = 1 To 9
If jisu(y, x) = 1 Then
Cells(y, x) = hh(y, x, 1)
GoTo E1 '从头再来
End If
Next
Next
''''''''''''''遇见候选数为2
For y = 1 To 9
For x = 1 To 9
If jisu(y, x) = 2 Then '2个候选数，选第一个数试
Cells(y, x) = hh(y, x, 1) '将第一个候选数写入单元格
zz = zz + 1 '路径计数
dzan(zz, 1) = 2 '候选数标志，也是节点标志
dzan(zz, 2) = y ' 行位置
dzan(zz, 3) = x ' 列位置
dzan(zz, 4) = hh(y, x, 1) '候选数1
dzan(zz, 5) = hh(y, x, 2) '候选数2
For i = 1 To 9
For r = 1 To 9
yskn(zz, i, r) = Cells(i, r) '将节点处的数据保存到数组
Next
Next
GoTo E1 '从头再来
End If
Next
Next
'End If '遇见候选数为2的结束
''''''''''''''''''''''遇见候选数为3
For y = 1 To 9
For x = 1 To 9
If jisu(y, x) = 3 Then '3个候选数，选第一个数试
Cells(y, x) = hh(y, x, 1)
zz = zz + 1
dzan(zz, 1) = 3
dzan(zz, 2) = y
dzan(zz, 3) = x
dzan(zz, 4) = hh(y, x, 1)
dzan(zz, 5) = hh(y, x, 2)
dzan(zz, 6) = hh(y, x, 3) '候选数3
For i = 1 To 9
For r = 1 To 9
yskn(zz, i, r) = Cells(i, r)
Next
Next
GoTo E1 '从头再来
End If
Next
Next
''''''''''''''''''''''''''''''遇见候选数为3的结束
For y = 1 To 9
For x = 1 To 9
If Cells(y, x) = "" And jisu(y, x) = 0 Then '死路的条件
If dzan(zz, 1) = 2 Then
dzan(zz, 1) = 1 '表示两个数其中一个走不通，再试另外一个
Cells(dzan(zz, 2), dzan(zz, 3)) = dzan(zz, 5)
GoTo E1
End If
End If
Next
Next
For y = 1 To 9
For x = 1 To 9
If Cells(y, x) = "" And jisu(y, x) = 0 Then GoTo E3
If jisu(y, x) = 4 Then GoTo E4
Next
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = True '打开屏幕刷新
GoTo E5
E3: MsgBox "待解,有可能是本数独无解；也有可能本程序不能应付。"
GoTo E6
E4: MsgBox "待解,已知数太少，本程序不能应付。"
GoTo E6
E5:
For y = 1 To 9
Cells(y, 10) = Cells(y, 1) + Cells(y, 2) + Cells(y, 3) + Cells(y, 4) + Cells(y, 5) + Cells(y, 6) + Cells(y, 7) + Cells(y, 8) + Cells(y, 9) '计算行之和，用于检查
Cells(10, y) = Cells(1, y) + Cells(2, y) + Cells(3, y) + Cells(4, y) + Cells(5, y) + Cells(6, y) + Cells(7, y) + Cells(8, y) + Cells(9, y) '计算列之和，用于检查
Next
MsgBox "成功完成"
E6:
End Sub