Sudoku Solver En professionelt værktøj til at kunne løse komplekse sudoku-spil. VBA program bruger logik og gæt funktioner til at løse spillet.
Forklaring Sudoku solver bruger grundlæggende logik funktioner og ved denne metode eliminerer mulige tal i visse positioner. For komplekse spil det har også et gæt funktion og loops gennem forskellige løsninger, indtil den rigtige er fundet. Hele VBA / Excel program kan hentes nederst på denne side, god fornøjelse!
Kode Public Sub Sudoku_Solver_One ()
»Start program til at løse et skridt
Total = False
Call Sudoku_Solver (Total)
End Sub
Public Sub Sudoku_Solver_Total ()
»Start program til at løse komplet
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 kontrol if programmet har skrevet noget nyt til matricen if ikke så gætte programmet gennemføres
write_it = False
»Det array, som indeholder alle 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 Kolonne = 1 To 9
If Sudoku_Solver (Række, Kolonne, 0) = tom Then
write_it = False
"Grundlæggende metoder til at løse Sudoku
Call QuadrantCheck (Sudoku_Solver, Række, Kolonne, write_it)
Call RowCheck (Sudoku_Solver, Række, Kolonne, write_it)
Call ColumnCheck (Sudoku_Solver, Række, Kolonne, write_it)
Call QuadrantCheckIN (Sudoku_Solver, Række, Kolonne, write_it)
Call RowCheckIN (Sudoku_Solver, Række, Kolonne, write_it)
Call ColumnCheckIN (Sudoku_Solver, Række, Kolonne, write_it)
Call DetermineReady (Sudoku_Solver)
End If
Next
Next
»
Genstart = False
»Søger efter fejl if fejlen er fundet under første køre programmet slutter
Call CheckError (Sudoku_Solver, Genstart, start)
If Genstart = 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 Kolonne = 1 To 9
Sudoku_Solver (Række, Kolonne, 11) = Range ("C3"). Offset (Row - 1, kolonne - 1) .Value
Sudoku_Solver (Række, Kolonne, 0) = Range ("C3"). Offset (Row - 1, kolonne - 1) .Value
If Sudoku_Solver (Række, Kolonne, 0) = tom Then
For loops = 1 To 9
Sudoku_Solver (Række, Kolonne, loops) = 1
Next
Else
For loops = 1 To 9
Sudoku_Solver (Række, Kolonne, loops) = 0
Next
End If
If Kolonne <4 Then
If Row <4 Then
Sudoku_Solver (Række, Kolonne, 10) = 1
End If
If Row <7 And Row> 3 Then
Sudoku_Solver (Række, Kolonne, 10) = 4
End If
If Row> 6 Then
Sudoku_Solver (Række, Kolonne, 10) = 7
End If
End If
If Kolonne <7 And Kolonne> 3 Then
If Row <4 Then
Sudoku_Solver (Række, Kolonne, 10) = 2
End If
If Row <7 And Row> 3 Then
Sudoku_Solver (Række, Kolonne, 10) = 5
End If
If Row> 6 Then
Sudoku_Solver (Række, Kolonne, 10) = 8
End If
End If
If Kolonne> 6 Then
If Row <4 Then
Sudoku_Solver (Række, Kolonne, 10) = 3
End If
If Row <7 And Row> 3 Then
Sudoku_Solver (Række, Kolonne, 10) = 6
End If
If Row> 6 Then
Sudoku_Solver (Række, Kolonne, 10) = 9
End If
End If
Next
Next
End Sub
Public Sub write_itData (Sudoku_Solver, write_it)
For Row = 1 To 9
For Kolonne = 1 To 9
If Range ("n3"). Offset (Row - 1, kolonne - 1) .Value = tom Then
If Sudoku_Solver (Række, Kolonne, 0) <> Tom Then
Range ("n3"). Offset (Row - 1, kolonne - 1) .Value = Sudoku_Solver (Række, Kolonne, 0)
write_it = True
End If
End If
Next
Next
End Sub
Public Sub DetermineReady (Sudoku_Solver)
For Row = 1 To 9
For Kolonne = 1 To 9
For VÄRDE = 1 To 9
If Sudoku_Solver (Række, Kolonne, Varde) = 1 Then
Antal = Antal + 1
värdeTal = VÄRDE
End If
Next
If Antal = 1 Then
Sudoku_Solver (Række, Kolonne, värdeTal) = 0
Sudoku_Solver (Række, Kolonne, 0) = värdeTal
End If
Antal = 0
Next
Next
End Sub
»
Public Sub QuadrantCheck (Sudoku_Solver, Række, Kolonne, write_it)
kvadrant = Sudoku_Solver (Række, Kolonne, 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 (Række, Kolonne, tal) = 1 Then
Sudoku_Solver (Række, Kolonne, tal) = 0
write_it = True
End If
End If
End If
Next
Next
End Sub
Public Sub RowCheck (Sudoku_Solver, Række, Kolonne, 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 (Række, Kolonne, värdeTal) = 1 Then
Sudoku_Solver (Række, Kolonne, värdeTal) = 0
write_it = True
End If
End If
Next
End Sub
Public Sub ColumnCheck (Sudoku_Solver, Række, Kolonne, write_it)
For RowT = 1 To 9
If Sudoku_Solver (RowT, kolonne, 0) <> Tom Then
värdeTal = Sudoku_Solver (RowT, kolonne, 0)
If Sudoku_Solver (Række, Kolonne, värdeTal) = 1 Then
Sudoku_Solver (Række, Kolonne, värdeTal) = 0
write_it = True
End If
End If
Next
End Sub
Public Sub QuadrantCheckIN (Sudoku_Solver, Række, Kolonne, write_it)
kvadrant = Sudoku_Solver (Række, Kolonne, 10)
For VÄRDE = 1 To 9
UNIK = True
If Sudoku_Solver (Række, Kolonne, Varde) = 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, Varde) = 1 Then
If Row = RowT And Kolonne = ColumnT Then
Else
UNIK = False
End If
End If
End If
Next
Next
If unik = True Then
Sudoku_Solver (Række, Kolonne, 0) = VÄRDE
write_it = True
For lups = 1 To 9
Sudoku_Solver (Række, Kolonne, lups) = 0
Next
End If
End If
Next
End Sub
Public Sub RowCheckIN (Sudoku_Solver, Række, Kolonne, write_it)
For VÄRDE = 1 To 9
UNIK = True
If Sudoku_Solver (Række, Kolonne, Varde) = 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, Varde) = 1 Then
If ColumnT <> Kolonne Then
UNIK = False
End If
End If
Next
If unik = True Then
Sudoku_Solver (Række, Kolonne, 0) = VÄRDE
write_it = True
For lups = 1 To 9
Sudoku_Solver (Række, Kolonne, lups) = 0
Next
End If
End If
Next
End Sub
»
Public Sub ColumnCheckIN (Sudoku_Solver, Række, Kolonne, write_it)
kvadrant = Sudoku_Solver (Række, Kolonne, 10)
For VÄRDE = 1 To 9
UNIK = True
If Sudoku_Solver (Række, Kolonne, Varde) = 1 Then
For RowT = 1 To 9
If Sudoku_Solver (RowT, kolonne, 0) = VÄRDE Then
UNIK = False
End If
If Sudoku_Solver (RowT, kolonne, Varde) = 1 Then
If RowT <> Row Then
UNIK = False
End If
End If
Next
If unik = True Then
Sudoku_Solver (Række, Kolonne, 0) = VÄRDE
write_it = True
For lups = 1 To 9
Sudoku_Solver (Række, Kolonne, lups) = 0
Next
End If
End If
Next
End Sub
Public Sub Guess (Sudoku_Solver, write_it, StartAllOver)
»Identificere bedste gæt sted
SlutSumma = 10
For Row = 1 To 9
For Kolonne = 1 To 9
If Sudoku_Solver (Række, Kolonne, 0) = tom Then
For lups = 1 To 9
summa = summa + Sudoku_Solver (Række, Kolonne, lups)
Next
If summa <SlutSumma Then
SlutRow = Row
SlutColumn = Kolonne
SlutSumma = summa
End If
summa = 0
End If
Next
Next
If SlutSumma <> 0 Then
»Tilfældigt tal mellem 1 og 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, Genstart, start)
Dim R (9)
Dim C (9)
For Værdi = 1 To 9
For Row = 1 To 9
Erase R
For Kolonne = 1 To 9
If Sudoku_Solver (Række, Kolonne, 0) <> 0 Then
R (Sudoku_Solver (Række, Kolonne, 0)) = R (Sudoku_Solver (Række, Kolonne, 0)) + 1
If R (Sudoku_Solver (Række, Kolonne, 0))> 1 Then Genstart = True
End If
Next
Next
For kolonne2 = 1 To 9
Erase C
For RÆKKE2 = 1 To 9
If Sudoku_Solver (RÆKKE2, kolonne2, 0) <> 0 Then
C (Sudoku_Solver (RÆKKE2, kolonne2, 0)) = C (Sudoku_Solver (RÆKKE2, kolonne2, 0)) + 1
If K (Sudoku_Solver (RÆKKE2, kolonne2, 0))> 1 Then Genstart = True
End If
Next
Next
Next
End Sub
Public Sub CheckReady (Sudoku_Solver, ER)
For Row = 1 To 9
For Kolonne = 1 To 9
Summan = Summan + Sudoku_Solver (Række, Kolonne, 0)
If Sudoku_Solver (Række, Kolonne, 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)
Kolonne = Int ((9 * Rnd) + 1)
If Sudoku_Solver (Række, Kolonne, 11) = tom Then
Range ("n3"). Offset (Row - 1, kolonne - 1) .Value = Sudoku_Solver (Række, Kolonne, 0)
Range ("n3"). Offset (Row - 1, kolonne - 1) .Interior.ColorIndex = 4
OneRandom = True
End If
Wend
End Sub
Download excel filen!Sudoku_Solver.xls |
