用VBA解数独游戏的方法
工具/原料
EXCEL
VBA
方法/步骤
1、将数独的已知数填入活动表的A1：I9单元格，打开宏编辑器，将如下语句考入编辑区。运行宏即可
2、Sub数独()'本程序有很多不足，欢迎改进！Dimi钽吟篑瑜AsByte,tAsByte,rAsByte,惺绅寨瞀xAsByte,yAsByte,zzAsIntegerDimtaAsByte，tcAsDoubleDimhh(1To9,1To9,1To9)AsByte'用于保存每个单元格中可能的数，经过排序最后一维保存的数从大到小，一维、二维是单元格的位置Dimg(1To9,1To9)AsByte,gg(1To9)AsByte'九宫和九宫的和Dimypsi(1To9,1To9)AsByte,yskn(0To99999,1To9,1To9)AsByte'原始数组和分叉时保存数据的数组0是起始数,原始可能的数。Dimjisu(1To9,1To9)AsByte'计数数组，由于统计每个单元格可能数字的个数，及数组hh(y,x,i)中i保留了几位数Dimzsjw(1To9)AsByte'中间数组Dimdzan(0To99999,1To6)AsInteger'记录路径，候选数，历遍标志MsgBox"根据游戏的难易程度有可能等待几秒到几十分钟，请耐心等待！点击“确认”开始"Application.ScreenUpdating=False'关闭屏幕刷新Fory=1To9Forx=1To9ypsi(y,x)=Cells(y,x)'把原始数据保留到数组NextNextyskn(0,1,1)=0zz=0ta=0E1:Fory=1To9Forx=1To9IfCells(y,x)=0ThenCells(y,x)=""'如果单元格中有0数组将溢出，此处做技术处理NextNextg(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)Fory=1To9'gg(y)=0Fori=1To9jisu(y,i)=0'对计数数组赋值'gg(y)=gg(y)+g(y,i)'对每一宫的数进行合计Fort=1To9hh(y,i,t)=tNextNextNext'''分段3Fory=1To9Forx=1To9IfCells(y,x)>0AndCells(y,x)<10Then'如果宫格里的数已经确定则将该数读入列Fori=1To9hh(y,x,i)=0NextElseFori=1To9IfCells(y,i)<>""OrCells(y,i)<>0Thenr=Cells(y,i)'去掉行里有的数hh(y,x,r)=0EndIfNextFort=1To9IfCells(t,x)<>""OrCells(t,x)<>0Thenr=Cells(t,x)'去掉列里有的数hh(y,x,r)=0EndIfNextIfy=1Ory=2Ory=3Then''AIfx=1Orx=2Orx=3ThenFort=1To9'去掉宫1里有的数Ifg(1,t)<>0Thenr=g(1,t)hh(y,x,r)=0EndIfNextElseIfx=4Orx=5Orx=6ThenFort=1To9'去掉宫2里有的数Ifg(2,t)<>0Thenr=g(2,t)hh(y,x,r)=0EndIfNextElseFort=1To9'去掉宫3里有的数Ifg(3,t)<>0Thenr=g(3,t)hh(y,x,r)=0EndIfNextEndIfEndIf'''''''''''''Else''1Ify=4Ory=5Ory=6ThenIfx=1Orx=2Orx=3Then''''3Fort=1To9'去掉宫4里有的数Ifg(4,t)<>0Thenr=g(4,t)hh(y,x,r)=0EndIfNextElseIfx=4Orx=5Orx=6ThenFort=1To9'去掉宫5里有的数Ifg(5,t)<>0Thenr=g(5,t)hh(y,x,r)=0EndIfNextElseFort=1To9'去掉宫6里有的数Ifg(6,t)<>0Thenr=g(6,t)hh(y,x,r)=0EndIfNextEndIfEndIf''''3ElseIfy=7Ory=8Ory=9ThenIfx=1Orx=2Orx=3Then''''3Fort=1To9'去掉宫7里有的数Ifg(7,t)<>0Thenr=g(7,t)hh(y,x,r)=0EndIfNextElseIfx=4Orx=5Orx=6ThenFort=1To9'去掉宫8里有的数Ifg(8,t)<>0Thenr=g(8,t)hh(y,x,r)=0EndIfNextElseFort=1To9'去掉宫9里有的数Ifg(9,t)<>0Thenr=g(9,t)hh(y,x,r)=0EndIfNextEndIfEndIfEndIf''''3EndIf'''1EndIf''AEndIfFori=1To9Ifhh(y,x,i)<>0Then'对单元格（数组）可能的数字进行计数jisu(y,x)=jisu(y,x)+1EndIfNextNextNext'''''''对可能的数进行从大到小的排序Fory=1To9Forx=1To9Fori=1To9zsjw(i)=hh(y,x,i)NextFori=1To9hh(y,x,i)=Application.WorksheetFunction.Large(zsjw,i)'降序排序函数和升序small一样NextNextNext'''''''排序结束''''''对走不通的单元格进行判断Fory=1To9Forx=1To9IfCells(y,x)=""Andjisu(y,x)=0Then'死路的条件Fortc=1Tozz'''''''用负步长此处溢出，采取技术处理，有可能是VBA的bagIfdzan(zz-tc,1)=2Ordzan(zz-tc,1)=3Then'判断有2个候选数和有3个候选数Ifdzan(zz-tc,1)=2Thendzan(zz-tc,1)=1Fori=1To9Fort=1To9Cells(i,t)=yskn(zz-tc,i,t)NextNextCells(dzan(zz-tc,2),dzan(zz-tc,3))=dzan(zz-tc,5)GoToE1EndIfIfdzan(zz-tc,1)=3Then''有3个候选数选第3个再试dzan(zz-tc,1)=2Fori=1To9Fort=1To9Cells(i,t)=yskn(zz-tc,i,t)NextNextCells(dzan(zz-tc,2),dzan(zz-tc,3))=dzan(zz-tc,6)GoToE1EndIfEndIfNexttcEndIfNextNext''''''判断结束'''''''''''注释1，jisu数组中只有一个数（0除外）时，将相应的数写入相应的单元格并从头再来Fory=1To9Forx=1To9Ifjisu(y,x)=1ThenCells(y,x)=hh(y,x,1)GoToE1'从头再来EndIfNextNext''''''''''''''遇见候选数为2Fory=1To9Forx=1To9Ifjisu(y,x)=2Then'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)'候选数1dzan(zz,5)=hh(y,x,2)'候选数2Fori=1To9Forr=1To9yskn(zz,i,r)=Cells(i,r)'将节点处的数据保存到数组NextNextGoToE1'从头再来EndIfNextNext'EndIf'遇见候选数为2的结束''''''''''''''''''''''遇见候选数为3Fory=1To9Forx=1To9Ifjisu(y,x)=3Then'3个候选数，选第一个数试Cells(y,x)=hh(y,x,1)zz=zz+1dzan(zz,1)=3dzan(zz,2)=ydzan(zz,3)=xdzan(zz,4)=hh(y,x,1)dzan(zz,5)=hh(y,x,2)dzan(zz,6)=hh(y,x,3)'候选数3Fori=1To9Forr=1To9yskn(zz,i,r)=Cells(i,r)NextNextGoToE1'从头再来EndIfNextNext''''''''''''''''''''''''''''''遇见候选数为3的结束Fory=1To9Forx=1To9IfCells(y,x)=""Andjisu(y,x)=0Then'死路的条件Ifdzan(zz,1)=2Thendzan(zz,1)=1'表示两个数其中一个走不通，再试另外一个Cells(dzan(zz,2),dzan(zz,3))=dzan(zz,5)GoToE1EndIfEndIfNextNextFory=1To9Forx=1To9IfCells(y,x)=""Andjisu(y,x)=0ThenGoToE3Ifjisu(y,x)=4ThenGoToE4NextNext'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Application.ScreenUpdating=True'打开屏幕刷新GoToE5E3:MsgBox"待解,有可能是本数独无解；也有可能本程序不能应付。"GoToE6E4:MsgBox"待解,已知数太少，本程序不能应付。"GoToE6E5:Fory=1To9Cells(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)'计算列之和，用于检查NextMsgBox"成功完成"E6:EndSub