]]>

samedi 31 mars 2007

Resoudre un Sudoku avec Excel

Je vous ai créé une macro excel qui permet de résoudre vos "Sudoku". Pour pouvoir, l'utiliser

1 Créez un classeur Excel
2 Renommez la Feuil1 Sudoku
3 Créer un bouton
4 Copiez coller le code suivant

Sub solution()

Call raz
impasse = 1
impasse_ini = 1
num_ligne_impasse = 1
num_colonne_impasse = 1

recherche_nouveau:
'recherche par ligne
For num_ligne_control = 1 To 9
For num_colonne_control = 1 To 9
chiffre_ligne = Sheets("Sudoku").Cells(num_ligne_control, num_colonne_control).Value
If chiffre_ligne <> "" Then
Call elimine_ligne(chiffre_ligne, num_ligne_control)
Sheets("Sudoku").Cells(num_ligne_control, num_colonne_control + 11) = ""
End If
Next num_colonne_control
Next num_ligne_control
'recherche par colonne
For num_colonne_control = 1 To 9
For num_ligne_control = 1 To 9
chiffre_colonne = Sheets("Sudoku").Cells(num_ligne_control, num_colonne_control).Value
If chiffre_colonne <> 0 Then
Call elimine_colonne(chiffre_colonne, num_colonne_control)
Sheets("Sudoku").Cells(num_ligne_control, num_colonne_control + 11) = ""
End If
Next num_ligne_control
Next num_colonne_control
'recherche par zone
colonne_depart_control = 1
ligne_depart_control = 1
For zone = 1 To 9
For num_colonne_control = colonne_depart_control To colonne_depart_control + 2
For num_ligne_control = ligne_depart_control To ligne_depart_control + 2
chiffre_zone = Sheets("Sudoku").Cells(num_ligne_control, num_colonne_control).Value
If chiffre_zone <> "" Then
Call elimine_zone(chiffre_zone, zone)
End If
Next num_ligne_control
Next num_colonne_control
Select Case zone
Case 1, 2, 4, 5, 7, 8
colonne_depart_control = colonne_depart_control + 3
If zone = 1 Or zone = 4 Or zone = 7 Then ligne_depart_control = zone

Case 3, 6
ligne_depart_control = zone + 1
colonne_depart_control = 1

End Select
Next zone
nbre_element = maj_sudoku()
If nbre_element > 0 Then
Do Until nbre_element = 0
GoTo recherche_nouveau
nbre_element = maj_sudoku()
Loop
End If
If Application.WorksheetFunction.Sum(Sheets("sudoku").Range("a1:i9")) = 405 Then
Range("A1").Select
Exit Sub
End If

'strategie du chiffre unique par zone
Call nouvelle_strategie
For zone = 1 To 9
Select Case zone
Case 1, 2, 3
num_ligne_depart = 1
num_colonne_depart = 1 + (zone * 3) - 3

Case 4, 5, 6
num_ligne_depart = 4
num_colonne_depart = 1 + ((zone - 4) * 3)
Case 7, 8, 9
num_ligne_depart = 7
num_colonne_depart = 1 + ((zone - 7) * 3)

End Select
For num_ligne = num_ligne_depart To num_ligne_depart + 2
For num_colonne = num_colonne_depart To num_colonne_depart + 2
For a = 1 To Len(Sheets("Sudoku").Cells(num_ligne, num_colonne + 11))
chiffre_unique = Mid(Sheets("Sudoku").Cells(num_ligne, num_colonne + 11), a, 1)
nbre_occurence = 0
For num_ligne_control = num_ligne_depart To num_ligne_depart + 2
For num_colonne_control = num_colonne_depart To num_colonne_depart + 2
occurence_chaine = InStr(1, Sheets("Sudoku").Cells(num_ligne_control, num_colonne_control + 11), chiffre_unique, vbTextCompare)
If occurence_chaine > 0 Then
nbre_occurence = nbre_occurence + 1
End If
Next num_colonne_control
Next num_ligne_control
If nbre_occurence = 1 Then
Sheets("Sudoku").Cells(num_ligne, num_colonne + 11) = chiffre_unique
End If
Next a
Next num_colonne
Next num_ligne
Next zone
nbre_element = maj_sudoku()
If nbre_element > 0 Then
Do Until nbre_element = 0
GoTo recherche_nouveau
nbre_element = maj_sudoku()
Loop
End If
If Application.WorksheetFunction.Sum(Sheets("sudoku").Range("a1:i9")) = 405 Then
Range("A1").Select
Exit Sub
End If
'strategie du chiffre unique par colonne
Call nouvelle_strategie

For num_colonne = 1 To 9
num_ligne_depart = 1
For num_ligne = 1 To 9
For a = 1 To Len(Sheets("Sudoku").Cells(num_ligne, num_colonne + 11))
chiffre_unique = Mid(Sheets("Sudoku").Cells(num_ligne, num_colonne + 11), a, 1)
nbre_occurence = 0
For num_ligne_control = 1 To 9
occurence_chaine = InStr(1, Sheets("Sudoku").Cells(num_ligne_control, num_colonne + 11), chiffre_unique, vbTextCompare)
If occurence_chaine > 0 Then
nbre_occurence = nbre_occurence + 1
End If
Next num_ligne_control
If nbre_occurence = 1 Then
Sheets("Sudoku").Cells(num_ligne, num_colonne + 11) = chiffre_unique
End If
Next a
Next num_ligne
Next num_colonne
nbre_element = maj_sudoku()
If nbre_element > 0 Then
Do Until nbre_element = 0
GoTo recherche_nouveau
nbre_element = maj_sudoku()
Loop
End If
If Application.WorksheetFunction.Sum(Sheets("sudoku").Range("a1:i9")) = 405 Then
Range("A1").Select
Exit Sub
End If
'strategie du chiffre unique par ligne
Call nouvelle_strategie

For num_ligne = 1 To 9
num_colonne_depart = 1
For num_colonne = 1 To 9
For a = 1 To Len(Sheets("Sudoku").Cells(num_ligne, num_colonne + 11))
chiffre_unique = Mid(Sheets("Sudoku").Cells(num_ligne, num_colonne + 11), a, 1)
nbre_occurence = 0
For num_colonne_control = 1 To 9
occurence_chaine = InStr(1, Sheets("Sudoku").Cells(num_ligne, num_colonne_control + 11), chiffre_unique, vbTextCompare)
If occurence_chaine > 0 Then
nbre_occurence = nbre_occurence + 1
End If
Next num_colonne_control
If nbre_occurence = 1 Then
Sheets("Sudoku").Cells(num_ligne, num_colonne + 11) = chiffre_unique
End If
Next a
Next num_colonne
Next num_ligne
nbre_element = maj_sudoku()
If nbre_element > 0 Then
Do Until nbre_element = 0
GoTo recherche_nouveau
nbre_element = maj_sudoku()
Loop
End If
If Application.WorksheetFunction.Sum(Sheets("sudoku").Range("a1:i9")) = 405 Then
Sheets("Sudoku").Range("A1").Select
Exit Sub
End If
'theorie de l'impasse
num_ligne = num_ligne_impasse
num_colonne = num_colonne_impasse
If impasse = 1 Then
If impasse_ini = 1 Then
Sheets("sudoku").Range("A12:i20").Value = Sheets("sudoku").Range("l1:T9").Value
impasse_ini = impasse_ini + 1
Else
Sheets("sudoku").Range("A12:i20").Value = Sheets("sudoku").Range("l1:T9").Value
End If
Sheets("sudoku").Range("A32:i40").Value = Sheets("sudoku").Range("A1:I9").Value
Do Until long_nombre_impasse = 2
long_nombre_impasse = Len(Sheets("sudoku").Cells(num_ligne, num_colonne + 11))
num_ligne_impasse = num_ligne
num_colonne_impasse = num_colonne
num_colonne = num_colonne + 1
If num_colonne = 10 Then
num_colonne = 1
num_ligne = num_ligne + 1
End If
Loop
Sheets("sudoku").Cells(num_ligne_impasse, num_colonne_impasse) = Left(Sheets("sudoku").Cells(num_ligne_impasse, num_colonne_impasse + 11), 1)
Sheets("sudoku").Cells(num_ligne_impasse + 21, num_colonne_impasse) = Left(Sheets("sudoku").Cells(num_ligne_impasse, num_colonne_impasse + 11), 1)
impasse = impasse + 1
long_nombre_impasse = 0
GoTo recherche_nouveau
End If
If impasse = 2 Then
Sheets("sudoku").Range("l1:T9").Value = Sheets("sudoku").Range("A12:i20").Value
Sheets("sudoku").Range("A1:I9").Value = Sheets("sudoku").Range("A32:i40").Value
Sheets("sudoku").Cells(num_ligne_impasse, num_colonne_impasse) = Right(Sheets("sudoku").Cells(num_ligne_impasse, num_colonne_impasse + 11), 1)
Sheets("sudoku").Cells(num_ligne_impasse + 21, num_colonne_impasse) = Sheets("sudoku").Cells(num_ligne_impasse + 21, num_colonne_impasse) & Right(Sheets("sudoku").Cells(num_ligne_impasse, num_colonne_impasse + 11), 1)
impasse = 1
num_colonne = num_colonne + 1
If num_colonne = 10 Then
num_colonne = 1
num_ligne = num_ligne + 1
End If
GoTo recherche_nouveau
End If
End Sub
Sub raz()
Sheets("Sudoku").Range("A12:I20").Select
Selection.ClearContents
Sheets("Sudoku").Range("A22:I30").Select
Selection.ClearContents
Sheets("Sudoku").Range("A32:I40").Select
Selection.ClearContents
For num_ligne = 1 To 9
For num_colonne = 12 To 20
Sheets("Sudoku").Cells(num_ligne, num_colonne) = 123456789
Next num_colonne
Next num_ligne
End Sub

Sub elimine_ligne(chiffre, num_ligne)
For num_colonne = 12 To 20
Sheets("Sudoku").Cells(num_ligne, num_colonne) = Replace(Sheets("Sudoku").Cells(num_ligne, num_colonne), chiffre, "")
Next num_colonne
End Sub

Sub elimine_colonne(chiffre, num_colonne)
For num_ligne = 1 To 9
Sheets("Sudoku").Cells(num_ligne, num_colonne + 11) = Replace(Sheets("Sudoku").Cells(num_ligne, num_colonne + 11), chiffre, "")
Next num_ligne
End Sub
Sub elimine_zone(chiffre, zone)
Select Case zone
Case 1, 2, 3
num_ligne_depart = 1
num_colonne_depart = 1 + (zone * 3) - 3

Case 4, 5, 6
num_ligne_depart = 4
num_colonne_depart = 1 + ((zone - 4) * 3)
Case 7, 8, 9
num_ligne_depart = 7
num_colonne_depart = 1 + ((zone - 7) * 3)

End Select

For num_ligne = num_ligne_depart To num_ligne_depart + 2
For num_colonne = num_colonne_depart To num_colonne_depart + 2
Sheets("Sudoku").Cells(num_ligne, num_colonne + 11) = Replace(Sheets("Sudoku").Cells(num_ligne, num_colonne + 11), chiffre, "")
Next num_colonne
Next num_ligne
End Sub
Function maj_sudoku()
nbre_element_maj = 0
For num_ligne = 1 To 9
For num_colonne = 1 To 9
If Sheets("Sudoku").Cells(num_ligne, num_colonne) <> "" Then Sheets("Sudoku").Cells(num_ligne, num_colonne + 11) = ""
If Len(Sheets("Sudoku").Cells(num_ligne, num_colonne + 11)) = 1 Then
Sheets("Sudoku").Cells(num_ligne, num_colonne) = Sheets("Sudoku").Cells(num_ligne, num_colonne + 11)
Sheets("Sudoku").Cells(num_ligne, num_colonne + 11) = ""
nbre_element_maj = nbre_element_maj + 1
End If
Next num_colonne
Next num_ligne
maj_sudoku = nbre_element_maj
End Function
Sub nouvelle_strategie()
For num_ligne = 1 To 9
For num_colonne = 1 To 9
If Sheets("Sudoku").Cells(num_ligne, num_colonne) <> "" Then
Sheets("Sudoku").Cells(num_ligne, num_colonne + 11) = Sheets("Sudoku").Cells(num_ligne, num_colonne)
End If
Next num_colonne
Next num_ligne
End Sub

Private Sub CommandButton1_Click()
Call solution
End Sub

Si vous n'arrivez pas à créer le fichier Excel, faites-moi un email, je vous l'enverrai

A bientôt

Thomas

3 commentaires:

courti a dit…

Salut

Super ton programme !!!

+5 !!!

http://tout-pour-auto.blogspot.com

Anonyme a dit…

ce que je cherchais, merci

carolina a dit…

Merci pour ce programme. J'avais déjà téléchargé un programme de sudoku en VBA mais il ne marchait pas très bien.

carolina
domo-sudoku