EXCEL
VBA
将数独的已知数填入活动表的A1：I9单元格，打开宏编辑器，将如下语句考入编辑区。运行宏即可
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 = 0E1: 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 '''分段3For 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 ''AEnd If For i = 1 To 9 If hh(y, x, i) <> 0 Then '对单元格（数组）可能的数字进行计数 jisu(y, x) = jisu(y, x) + 1 End If NextNextNext'''''''对可能的数进行从大到小的排序 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 NextNext''''''判断结束'''''''''''注释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的结束''''''''''''''''''''''遇见候选数为3For 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 NextNextFor 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 NextNext ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Application.ScreenUpdating = True '打开屏幕刷新 GoTo E5E3: MsgBox '待解,有可能是本数独无解；也有可能本程序不能应付。' GoTo E6E4: MsgBox '待解,已知数太少，本程序不能应付。' GoTo E6E5: 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