数独求解一个专业的工具，能够解决复杂的数独游戏。在VBA程序使用的逻辑和猜测功能，解决了比赛。
解释数独解算器使用基本的逻辑功能和消除这种做法在某些职位可能数量。对于复杂的游戏也经历了不同的解决方案，直到找到一个正确的猜测和循环功能。 整个VBA / Excel程序是在本页面底部，可供下载欣赏！
码Public Sub Sudoku_Solver_One()
'Start program to solve one step
Total = False
Call Sudoku_Solver(Total)
End Sub
Public Sub Sudoku_Solver_Total()
'Start program to solve complete
Total = True
Call Sudoku_Solver(Total)
End Sub
Public Sub Sudoku_Solver(Total)
Range("N3:V11").ClearContents
Range("N3:V11").Interior.ColorIndex = 0
'write_it controls if the program has written anything new to the matrix if not then the guess program is executed
write_it = False
'The array containing all data
Dim Sudoku_Solver(9, 9, 40)
Call ReadInData(Sudoku_Solver)
Call write_itData(Sudoku_Solver, write_it)
Call DetermineReady(Sudoku_Solver)
lups = 0
ER = False
While ER = False
For Row = 1 To 9
For Column = 1 To 9
If Sudoku_Solver(Row, Column, 0) = tom Then
write_it = False
'Basic methods for solving Sudoku
Call QuadrantCheck(Sudoku_Solver, Row, Column, write_it)
Call RowCheck(Sudoku_Solver, Row, Column, write_it)
Call ColumnCheck(Sudoku_Solver, Row, Column, write_it)
Call QuadrantCheckIN(Sudoku_Solver, Row, Column, write_it)
Call RowCheckIN(Sudoku_Solver, Row, Column, write_it)
Call ColumnCheckIN(Sudoku_Solver, Row, Column, write_it)
Call DetermineReady(Sudoku_Solver)
End If
Next
Next
'
ReStart = False
'Searches for errors if the error is found during first run the program ends
Call CheckError(Sudoku_Solver, ReStart, start)
If ReStart = True Then
write_it = True
Erase Sudoku_Solver
Call ReadInData(Sudoku_Solver)
Range("N3:V11").ClearContents
Call write_itData(Sudoku_Solver, write_it)
StartAllOver = StartAllOver + 1
If StartAllOver > 1000 Then
End
End If
If lups = 0 Then
End
End If
End If
If write_it = False Then
Call Guess(Sudoku_Solver, write_it, StartAllOver)
End If
Call DetermineReady(Sudoku_Solver)
If Total = True Then
Call write_itData(Sudoku_Solver, write_it)
End If
Call CheckReady(Sudoku_Solver, ER)
lups = lups + 1
Wend
If Total = False Then
Call WriteOne(Sudoku_Solver)
End If
End Sub
Public Sub ReadInData(Sudoku_Solver)
For Row = 1 To 9
For Column = 1 To 9
Sudoku_Solver(Row, Column, 11) = Range("c3").Offset(Row - 1, Column - 1).Value
Sudoku_Solver(Row, Column, 0) = Range("c3").Offset(Row - 1, Column - 1).Value
If Sudoku_Solver(Row, Column, 0) = tom Then
For loops = 1 To 9
Sudoku_Solver(Row, Column, loops) = 1
Next
Else
For loops = 1 To 9
Sudoku_Solver(Row, Column, loops) = 0
Next
End If
If Column < 4 Then
If Row < 4 Then
Sudoku_Solver(Row, Column, 10) = 1
End If
If Row < 7 And Row > 3 Then
Sudoku_Solver(Row, Column, 10) = 4
End If
If Row > 6 Then
Sudoku_Solver(Row, Column, 10) = 7
End If
End If
If Column < 7 And Column > 3 Then
If Row < 4 Then
Sudoku_Solver(Row, Column, 10) = 2
End If
If Row < 7 And Row > 3 Then
Sudoku_Solver(Row, Column, 10) = 5
End If
If Row > 6 Then
Sudoku_Solver(Row, Column, 10) = 8
End If
End If
If Column > 6 Then
If Row < 4 Then
Sudoku_Solver(Row, Column, 10) = 3
End If
If Row < 7 And Row > 3 Then
Sudoku_Solver(Row, Column, 10) = 6
End If
If Row > 6 Then
Sudoku_Solver(Row, Column, 10) = 9
End If
End If
Next
Next
End Sub
Public Sub write_itData(Sudoku_Solver, write_it)
For Row = 1 To 9
For Column = 1 To 9
If Range("n3").Offset(Row - 1, Column - 1).Value = tom Then
If Sudoku_Solver(Row, Column, 0) <> tom Then
Range("n3").Offset(Row - 1, Column - 1).Value = Sudoku_Solver(Row, Column, 0)
write_it = True
End If
End If
Next
Next
End Sub
Public Sub DetermineReady(Sudoku_Solver)
For Row = 1 To 9
For Column = 1 To 9
For värde = 1 To 9
If Sudoku_Solver(Row, Column, värde) = 1 Then
antal = antal + 1
värdeTal = värde
End If
Next
If antal = 1 Then
Sudoku_Solver(Row, Column, värdeTal) = 0
Sudoku_Solver(Row, Column, 0) = värdeTal
End If
antal = 0
Next
Next
End Sub
'
Public Sub QuadrantCheck(Sudoku_Solver, Row, Column, write_it)
kvadrant = Sudoku_Solver(Row, Column, 10)
For RowT = 1 To 9
For ColumnT = 1 To 9
If Sudoku_Solver(RowT, ColumnT, 10) = kvadrant Then
If Sudoku_Solver(RowT, ColumnT, 0) <> tom Then
tal = Sudoku_Solver(RowT, ColumnT, 0)
If Sudoku_Solver(Row, Column, tal) = 1 Then
Sudoku_Solver(Row, Column, tal) = 0
write_it = True
End If
End If
End If
Next
Next
End Sub
Public Sub RowCheck(Sudoku_Solver, Row, Column, write_it)
For ColumnT = 1 To 9
If Sudoku_Solver(Row, ColumnT, 0) <> tom Then
värdeTal = Sudoku_Solver(Row, ColumnT, 0)
If Sudoku_Solver(Row, Column, värdeTal) = 1 Then
Sudoku_Solver(Row, Column, värdeTal) = 0
write_it = True
End If
End If
Next
End Sub
Public Sub ColumnCheck(Sudoku_Solver, Row, Column, write_it)
For RowT = 1 To 9
If Sudoku_Solver(RowT, Column, 0) <> tom Then
värdeTal = Sudoku_Solver(RowT, Column, 0)
If Sudoku_Solver(Row, Column, värdeTal) = 1 Then
Sudoku_Solver(Row, Column, värdeTal) = 0
write_it = True
End If
End If
Next
End Sub
Public Sub QuadrantCheckIN(Sudoku_Solver, Row, Column, write_it)
kvadrant = Sudoku_Solver(Row, Column, 10)
For värde = 1 To 9
unik = True
If Sudoku_Solver(Row, Column, värde) = 1 Then
For RowT = 1 To 9
For ColumnT = 1 To 9
If Sudoku_Solver(RowT, ColumnT, 10) = kvadrant Then
If Sudoku_Solver(RowT, ColumnT, 0) = värde Then unik = False
If Sudoku_Solver(RowT, ColumnT, värde) = 1 Then
If Row = RowT And Column = ColumnT Then
Else
unik = False
End If
End If
End If
Next
Next
If unik = True Then
Sudoku_Solver(Row, Column, 0) = värde
write_it = True
For lups = 1 To 9
Sudoku_Solver(Row, Column, lups) = 0
Next
End If
End If
Next
End Sub
Public Sub RowCheckIN(Sudoku_Solver, Row, Column, write_it)
For värde = 1 To 9
unik = True
If Sudoku_Solver(Row, Column, värde) = 1 Then
For ColumnT = 1 To 9
If Sudoku_Solver(Row, ColumnT, 0) = värde Then
unik = False
End If
If Sudoku_Solver(Row, ColumnT, värde) = 1 Then
If ColumnT <> Column Then
unik = False
End If
End If
Next
If unik = True Then
Sudoku_Solver(Row, Column, 0) = värde
write_it = True
For lups = 1 To 9
Sudoku_Solver(Row, Column, lups) = 0
Next
End If
End If
Next
End Sub
'
Public Sub ColumnCheckIN(Sudoku_Solver, Row, Column, write_it)
kvadrant = Sudoku_Solver(Row, Column, 10)
For värde = 1 To 9
unik = True
If Sudoku_Solver(Row, Column, värde) = 1 Then
For RowT = 1 To 9
If Sudoku_Solver(RowT, Column, 0) = värde Then
unik = False
End If
If Sudoku_Solver(RowT, Column, värde) = 1 Then
If RowT <> Row Then
unik = False
End If
End If
Next
If unik = True Then
Sudoku_Solver(Row, Column, 0) = värde
write_it = True
For lups = 1 To 9
Sudoku_Solver(Row, Column, lups) = 0
Next
End If
End If
Next
End Sub
Public Sub Guess(Sudoku_Solver, write_it, StartAllOver)
'identify best guess place
SlutSumma = 10
For Row = 1 To 9
For Column = 1 To 9
If Sudoku_Solver(Row, Column, 0) = tom Then
For lups = 1 To 9
summa = summa + Sudoku_Solver(Row, Column, lups)
Next
If summa < SlutSumma Then
SlutRow = Row
SlutColumn = Column
SlutSumma = summa
End If
summa = 0
End If
Next
Next
If SlutSumma <> 0 Then
'Random number between 1 and 9
hittat = False
While hittat = False
Randomize
tal = Int((9 * Rnd) + 1)
If Sudoku_Solver(SlutRow, SlutColumn, tal) = 1 Then
hittat = True
Sudoku_Solver(SlutRow, SlutColumn, 0) = tal
For lups = 1 To 9
Sudoku_Solver(SlutRow, SlutColumn, lups) = 0
write_it = True
Next
End If
Wend
Else
Erase Sudoku_Solver
write_it = True
Range("N3:V11").ClearContents
Call ReadInData(Sudoku_Solver)
Call write_itData(Sudoku_Solver, write_it)
StartAllOver = StartAllOver + 1
If StartAllOver > 1000 Then
End
End If
End If
'
End Sub
Public Sub CheckError(Sudoku_Solver, ReStart, start)
Dim R(9)
Dim C(9)
For Value = 1 To 9
For Row = 1 To 9
Erase R
For Column = 1 To 9
If Sudoku_Solver(Row, Column, 0) <> 0 Then
R(Sudoku_Solver(Row, Column, 0)) = R(Sudoku_Solver(Row, Column, 0)) + 1
If R(Sudoku_Solver(Row, Column, 0)) > 1 Then ReStart = True
End If
Next
Next
For Column2 = 1 To 9
Erase C
For Row2 = 1 To 9
If Sudoku_Solver(Row2, Column2, 0) <> 0 Then
C(Sudoku_Solver(Row2, Column2, 0)) = C(Sudoku_Solver(Row2, Column2, 0)) + 1
If C(Sudoku_Solver(Row2, Column2, 0)) > 1 Then ReStart = True
End If
Next
Next
Next
End Sub
Public Sub CheckReady(Sudoku_Solver, ER)
For Row = 1 To 9
For Column = 1 To 9
Summan = Summan + Sudoku_Solver(Row, Column, 0)
If Sudoku_Solver(Row, Column, 0) <> tom Then
Summan2 = Summan2 + 1
End If
Next
Next
If Summan = 405 And Summan2 = 81 Then
ER = True
End If
End Sub
Public Sub WriteOne(Sudoku_Solver)
OneRandom = False
While OneRandom = False
Randomize
Row = Int((9 * Rnd) + 1)
Column = Int((9 * Rnd) + 1)
If Sudoku_Solver(Row, Column, 11) = tom Then
Range("n3").Offset(Row - 1, Column - 1).Value = Sudoku_Solver(Row, Column, 0)
Range("n3").Offset(Row - 1, Column - 1).Interior.ColorIndex = 4
OneRandom = True
End If
Wend
End Sub
下载Excel文件！Sudoku_Solver.xls |
