Sudoku Ett professionellt verktyg för att kunna lösa komplexa sudoku spel. VBA-programmet använder logik och gissa funktioner för att lösa spelet.
Förklaring Sudoku lösare använder grundläggande logiska funktioner och genom denna metod eliminerar möjliga nummer i vissa positioner. För komplexa spel har det också en gissning funktion och loopar genom olika lösningar tills rätt ett hittas. Hela VBA / Excel-programmet finns att ladda ner längst ner på denna sida, njut!
Kod Public Sub Sudoku_Solver_One ()
"Start-programmet för att lösa ett steg
Totalt = False
Call Sudoku_Solver (Totalt)
End Sub
Public Sub Sudoku_Solver_Total ()
"Start-programmet för att lösa komplett
Totalt = True
Call Sudoku_Solver (Totalt)
End Sub
Public Sub Sudoku_Solver (Totalt)
Range ("N3: V11"). ClearContents
Range ("N3: V11") .Interior.ColorIndex = 0
"Write_it kontroller if programmet har skrivit något nytt att matrisen if inte då gissa programmet körs
write_it = False
"Den matris som innehåller alla uppgifter
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 Rad = 1 To 9
For Kolumn = 1 To 9
If Sudoku_Solver (rad, kolumn, 0) = tom Then
write_it = False
"Grundläggande metoder för att lösa Sudoku
Call QuadrantCheck (Sudoku_Solver, rad, kolumn, write_it)
Call RowCheck (Sudoku_Solver, rad, kolumn, write_it)
Call ColumnCheck (Sudoku_Solver, rad, kolumn, write_it)
Call QuadrantCheckIN (Sudoku_Solver, rad, kolumn, write_it)
Call RowCheckIN (Sudoku_Solver, rad, kolumn, write_it)
Call ColumnCheckIN (Sudoku_Solver, rad, kolumn, write_it)
Call DetermineReady (Sudoku_Solver)
End If
Next
Next
"
Starta = False
"Söker efter fel if felet hittas under första körningen programmet avslutas
Call CheckError (Sudoku_Solver, vila, start)
If Starta = 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 Gissa (Sudoku_Solver, write_it, StartAllOver)
End If
Call DetermineReady (Sudoku_Solver)
If Totalt = 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 Rad = 1 To 9
For Kolumn = 1 To 9
Sudoku_Solver (rad, kolumn 11) = Range ("C3"). Offset (Row - 1 kolumn - 1) .Value
Sudoku_Solver (rad, kolumn, 0) = Range ("C3"). Offset (Row - 1 kolumn - 1) .Value
If Sudoku_Solver (rad, kolumn, 0) = tom Then
For slingor = 1 To 9
Sudoku_Solver (rad, kolumn loopar) = 1
Next
Else
For slingor = 1 To 9
Sudoku_Solver (rad, kolumn loopar) = 0
Next
End If
If Kolumn <4 Then
If Row <4 Then
Sudoku_Solver (rad, kolumn 10) = 1
End If
If Row <7 And Rad> 3 Then
Sudoku_Solver (rad, kolumn 10) = 4
End If
If Rad> 6 Then
Sudoku_Solver (rad, kolumn 10) = 7
End If
End If
If kolumn <7 And Kolumn> 3 Then
If Row <4 Then
Sudoku_Solver (rad, kolumn 10) = 2
End If
If Row <7 And Rad> 3 Then
Sudoku_Solver (rad, kolumn 10) = 5
End If
If Rad> 6 Then
Sudoku_Solver (rad, kolumn 10) = 8
End If
End If
If Kolumn> 6 Then
If Row <4 Then
Sudoku_Solver (rad, kolumn 10) = 3
End If
If Row <7 And Rad> 3 Then
Sudoku_Solver (rad, kolumn 10) = 6
End If
If Rad> 6 Then
Sudoku_Solver (rad, kolumn 10) = 9
End If
End If
Next
Next
End Sub
Public Sub write_itData (Sudoku_Solver, write_it)
For Rad = 1 To 9
For Kolumn = 1 To 9
If Range (N3). Offset (Row - 1 kolumn - 1) .Value = tom Then
If Sudoku_Solver (rad, kolumn, 0) <> tom Then
Range (N3). Offset (Row - 1 kolumn - 1) .Value = Sudoku_Solver (rad, kolumn, 0)
write_it = True
End If
End If
Next
Next
End Sub
Public Sub DetermineReady (Sudoku_Solver)
For Rad = 1 To 9
For Kolumn = 1 To 9
For VÄRDE = 1 To 9
If Sudoku_Solver (rad, kolumn VÄRDE) = 1 Then
Antal = Antal + 1
värdeTal = VÄRDE
End If
Next
If Antal = 1 Then
Sudoku_Solver (rad, kolumn värdeTal) = 0
Sudoku_Solver (rad, kolumn, 0) = värdeTal
End If
Antal = 0
Next
Next
End Sub
"
Public Sub QuadrantCheck (Sudoku_Solver, rad, kolumn, write_it)
kvadrant = Sudoku_Solver (rad, kolumn 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 (rad, kolumn, tal) = 1 Then
Sudoku_Solver (rad, kolumn, tal) = 0
write_it = True
End If
End If
End If
Next
Next
End Sub
Public Sub RowCheck (Sudoku_Solver, rad, kolumn, 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 (rad, kolumn värdeTal) = 1 Then
Sudoku_Solver (rad, kolumn värdeTal) = 0
write_it = True
End If
End If
Next
End Sub
Public Sub ColumnCheck (Sudoku_Solver, rad, kolumn, write_it)
For RowT = 1 To 9
If Sudoku_Solver (RowT, kolumn, 0) <> tom Then
värdeTal = Sudoku_Solver (RowT, kolumn, 0)
If Sudoku_Solver (rad, kolumn värdeTal) = 1 Then
Sudoku_Solver (rad, kolumn värdeTal) = 0
write_it = True
End If
End If
Next
End Sub
Public Sub QuadrantCheckIN (Sudoku_Solver, rad, kolumn, write_it)
kvadrant = Sudoku_Solver (rad, kolumn 10)
For VÄRDE = 1 To 9
Unik = True
If Sudoku_Solver (rad, kolumn 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 Kolumn = ColumnT Then
Else
Unik = False
End If
End If
End If
Next
Next
If Unik = True Then
Sudoku_Solver (rad, kolumn, 0) = VÄRDE
write_it = True
For lups = 1 To 9
Sudoku_Solver (rad, kolumn lups) = 0
Next
End If
End If
Next
End Sub
Public Sub RowCheckIN (Sudoku_Solver, rad, kolumn, write_it)
For VÄRDE = 1 To 9
Unik = True
If Sudoku_Solver (rad, kolumn 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 <> Kolumn Then
Unik = False
End If
End If
Next
If Unik = True Then
Sudoku_Solver (rad, kolumn, 0) = VÄRDE
write_it = True
For lups = 1 To 9
Sudoku_Solver (rad, kolumn lups) = 0
Next
End If
End If
Next
End Sub
"
Public Sub ColumnCheckIN (Sudoku_Solver, rad, kolumn, write_it)
kvadrant = Sudoku_Solver (rad, kolumn 10)
For VÄRDE = 1 To 9
Unik = True
If Sudoku_Solver (rad, kolumn VÄRDE) = 1 Then
For RowT = 1 To 9
If Sudoku_Solver (RowT, kolumn, 0) = VÄRDE Then
Unik = False
End If
If Sudoku_Solver (RowT, kolumn, VÄRDE) = 1 Then
If RowT <> Rad Then
Unik = False
End If
End If
Next
If Unik = True Then
Sudoku_Solver (rad, kolumn, 0) = VÄRDE
write_it = True
For lups = 1 To 9
Sudoku_Solver (rad, kolumn lups) = 0
Next
End If
End If
Next
End Sub
Public Sub Gissa (Sudoku_Solver, write_it, StartAllOver)
"Identifiera gissa bästa platsen
SlutSumma = 10
For Rad = 1 To 9
For Kolumn = 1 To 9
If Sudoku_Solver (rad, kolumn, 0) = tom Then
For lups = 1 To 9
Summa = summa + Sudoku_Solver (rad, kolumn, lups)
Next
If summa <SlutSumma Then
SlutRow = Row
SlutColumn = Kolumn
SlutSumma = summa
End If
summa = 0
End If
Next
Next
If SlutSumma <> 0 Then
"Slumptal mellan 1 och 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, vila, start)
Dim R (9)
Dim C (9)
For Värde = 1 To 9
For Rad = 1 To 9
Erase R
For Kolumn = 1 To 9
If Sudoku_Solver (rad, kolumn, 0) <> 0 Then
R (Sudoku_Solver (rad, kolumn, 0)) = R (Sudoku_Solver (rad, kolumn, 0)) + 1
If R (Sudoku_Solver (rad, kolumn, 0))> 1 Then Starta = True
End If
Next
Next
For kolumn2 = 1 To 9
Erase C
For Row2 = 1 To 9
If Sudoku_Solver (Row2, kolumn2, 0) <> 0 Then
C (Sudoku_Solver (Row2, kolumn2, 0)) = C (Sudoku_Solver (Row2, kolumn2, 0)) + 1
If K (Sudoku_Solver (Row2, kolumn2, 0))> 1 Then Starta = True
End If
Next
Next
Next
End Sub
Public Sub CheckReady (Sudoku_Solver, ER)
For Rad = 1 To 9
For Kolumn = 1 To 9
Summan = Summan + Sudoku_Solver (rad, kolumn, 0)
If Sudoku_Solver (rad, kolumn, 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
Rad = Int ((9 * RND) + 1)
Kolumn = Int ((9 * RND) + 1)
If Sudoku_Solver (rad, kolumn 11) = tom Then
Range (N3). Offset (Row - 1 kolumn - 1) .Value = Sudoku_Solver (rad, kolumn, 0)
Range (N3). Offset (Row - 1 kolumn - 1) .Interior.ColorIndex = 4
OneRandom = True
End If
Wend
End Sub
Ladda ner Excel-fil!Sudoku_Solver.xls |
