Option Explicit
'|¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯|
'| Ajouter la référence à la bibliothèque Microsoft Scripting Runtime (scrrun.dll) au projet ! |
'|_____________________________________________________________________________________________|
Private d As New Scripting.Dictionary
Private n%, tl(0 To 6, 1 To 6)
Sub tata()
'Cette procédure initialise les paramètres puis lance le calcul.
Dim i%, j%, c
[B2:AI24].ClearContents
Set d = Nothing
Erase tl
'Chargement du dictionaire 'd'. Les enregistrements ont pour clés "6", "7", ..., "30" et pour items 6, 7, ..., 30.
'(Ce sont les nombres à placer dans le carré.)
For i = 6 To 30: d(i) = i: Next
'Le tableau 'c' décrit les données initiales que sont les neufs nombres déjà placés.
'Le premier item 'Array(2, 1, 29)' doit se comprendre ainsi : en ligne 2, colonne 1, on a placé 29.
'Le deuxième indique qu'on a placé 13 en ligne 3, colonne 1, etc.
c = Array(Array(2, 1, 29), Array(3, 1, 13), Array(5, 1, 21), _
Array(5, 2, 14), Array(2, 3, 15), Array(4, 3, 23), _
Array(1, 4, 24), Array(3, 4, 27), Array(2, 5, 16))
'Le tableau 'tl' représente l'état du carré et ses bordures inférieures et droites.
'Description du tableau :
'Le carré proprement dit est dans 'tl(1 to 5, 1 to 5)'.
''tl(0,1)','tl(0,2)','tl(0,3)','tl(0,4)','tl(0,5)' sont inutilisés.
''tl(0,6)' (respectivement 'tl(6,6)') contient la somme des éléments
'de la diagonale bas-gauche à haut-droite (resp. haut-gauche à bas-droite).
'La ligne du bas, colonnes 1 à 5, contient les sommes des éléments des colonnes correspondantes dans le carré.
'La colonne de droite, lignes 1 à 5, contient les sommes des éléments des lignes correspondantes dans le carré.
'Chargement du tableau et suppression du dictionnaire des nombres déjà placés dans le tableau :
For i = 0 To UBound(c): tl(c(i)(0), c(i)(1)) = c(i)(2): d.Remove (c(i)(2)): Next
For i = 1 To 5: For j = 1 To 5: tl(6, i) = tl(6, i) + tl(j, i): tl(i, 6) = tl(i, 6) + tl(i, j): Next: tl(0, 6) = tl(0, 6) + tl(6 - i, i): tl(6, 6) = tl(6, 6) + tl(i, i): Next
'Dans toute la suite, on s'arrangera pour que le dictionnaire contienne toujours les nombres restant à placer.
'Affichage du tableau dans la plage B2:G8 :
'('n' compte le nombre de tableaux affichés.)
[B2].Resize(7, 6).Value = tl: [B2].Value = "Données initiales": n = 1
col1 'Lance la recherche d'une solution...
End Sub
Private Sub col1()
'Cette procédure complète si possible la colonne 1 ;
'le cas échéant, elle appelle à compléter la ligne 2.
Dim i%, s%
'Somme des éléments dans la colonne 1.
For i = 1 To 5: s = s + tl(i, 1): Next
'Complément à 90.
s = 90 - s
'Recherche de deux éléments du dictionnaire ayant 's' pour somme.
For i = 5 To 30
If d.Exists(i) Then
d.Remove (i)
If d.Exists(s - i) Then
'On a trouvé deux éléments complétant la colonne à 90 :
'On les place dans le tableau et on les supprime du dictionnaire.
d.Remove (s - i): tl(1, 1) = i: tl(4, 1) = s - i
'Passage au complément de la ligne 2.
lig2
'Rétablissement des paramètres avant le passage à la recherche d'une autre solution.
tl(4, 1) = 0: tl(1, 1) = 0: d(s - i) = s - i
End If
d(i) = i
End If
Next
End Sub
Private Sub lig2()
'Cette procédure et les suivantes sont semblables à la précédente...
Dim i%, s%
For i = 1 To 5: s = s + tl(2, i): Next
s = 90 - s
For i = 5 To 30
If d.Exists(i) Then
d.Remove (i)
If d.Exists(s - i) Then
d.Remove (s - i): tl(2, 2) = i: tl(2, 4) = s - i
col4
tl(2, 4) = 0: tl(2, 2) = 0: d(s - i) = s - i
End If
d(i) = i
End If
Next
End Sub
Private Sub col4()
Dim i%, s%
For i = 1 To 5: s = s + tl(i, 4): Next
s = 90 - s
For i = 5 To 30
If d.Exists(i) Then
d.Remove (i)
If d.Exists(s - i) Then
d.Remove (s - i): tl(4, 4) = i: tl(5, 4) = s - i
lig5
tl(5, 4) = 0: tl(4, 4) = 0: d(s - i) = s - i
End If
d(i) = i
End If
Next
End Sub
Private Sub lig5()
Dim i%, s%
For i = 1 To 5: s = s + tl(5, i): Next
s = 90 - s
For i = 5 To 30
If d.Exists(i) Then
d.Remove (i)
If d.Exists(s - i) Then
d.Remove (s - i): tl(5, 3) = i: tl(5, 5) = s - i
lig4
tl(5, 5) = 0: tl(5, 3) = 0: d(s - i) = s - i
End If
d(i) = i
End If
Next
End Sub
Private Sub lig4()
Dim i%, s%
For i = 1 To 5: s = s + tl(4, i): Next
s = 90 - s
For i = 5 To 30
If d.Exists(i) Then
d.Remove (i)
If d.Exists(s - i) Then
d.Remove (s - i): tl(4, 2) = i: tl(4, 5) = s - i
col2
tl(4, 5) = 0: tl(4, 2) = 0: d(s - i) = s - i
End If
d(i) = i
End If
Next
End Sub
Private Sub col2()
Dim i%, s%
For i = 1 To 5: s = s + tl(i, 2): Next
s = 90 - s
For i = 5 To 30
If d.Exists(i) Then
d.Remove (i)
If d.Exists(s - i) Then
d.Remove (s - i): tl(1, 2) = i: tl(3, 2) = s - i
col3
tl(3, 2) = 0: tl(1, 2) = 0: d(s - i) = s - i
End If
d(i) = i
End If
Next
End Sub
Private Sub col3()
Dim i%, s%
For i = 1 To 5: s = s + tl(i, 3): Next
s = 90 - s
For i = 5 To 30
If d.Exists(i) Then
d.Remove (i)
If d.Exists(s - i) Then
d.Remove (s - i): tl(1, 3) = i: tl(3, 3) = s - i:
col5
tl(3, 3) = 0: tl(1, 3) = 0: d(s - i) = s - i
End If
d(i) = i
End If
Next
End Sub
Private Sub col5()
Dim i%, j%, s%, u%
For i = 1 To 5: s = s + tl(i, 5): Next
s = 90 - s
For i = 5 To 30
If d.Exists(i) Then
d.Remove (i)
If d.Exists(s - i) Then
d.Remove (s - i): tl(1, 5) = i: tl(3, 5) = s - i
'À cet endroit, le tableau est rempli.
'On contrôle que la ligne 1 a 90 pour somme.
u = 0: For j = 1 To 5: u = u + tl(1, j): Next
'Si la ligne 1 a 90 pour somme, on affiche le tableau.
If u = 90 Then
tl(0, 6) = 0: tl(6, 6) = 0: For j = 1 To 5: tl(6, j) = u: tl(j, 6) = u: tl(0, 6) = tl(0, 6) + tl(6 - j, j): tl(6, 6) = tl(6, 6) + tl(j, j): Next
[B2].Resize(7, 6).Offset(8 * (n \ 5), 7 * (n Mod 5)).Value = tl
n = n + 1
End If
tl(3, 5) = 0: tl(1, 5) = 0: d(s - i) = s - i
End If
d(i) = i
End If
Next
End Sub
