S E N D
+ M O R E
= M O N E Y
Chaque lettre représente un seul chiffre et le chiffre le plus significatif est différent de zéro. Idéalement, le casse-tête doit avoir une solution unique.
La solution est O=0, M=1, Y=2, E=5, N=6, D=7, R=8, and S=9.
Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?
Bonsoir à tous
En farfouillant sur le net j'ai fini par trouvé un script Qbasic
(que j'ai transcris en VBA)
Mais je suis par sur de comprendre sa logique
Ici dans cet exemple : SEW+WAS=SEEN
Code:
Sub alphameticII()
'adpaté de QBasic
'source:http://www.angelfire.com/ak/magic119/sawwasseen.html
'SAW+WAS=SEEN
Dim t(0 To 9) As Integer
For s = 1 To 9
For a = 0 To 9
For w = 0 To 9
For e = 0 To 9
For n = 0 To 9
saw = 100 * s + 10 * a + w
was = 100 * w + 10 * a + s
seen = 1000 * s + 100 * e + 10 * e + n
total = saw + was
If seen <> total Then GoTo lab7
For x = 0 To 9
t(0) = 0
Next x
If t(s) = 1 Then GoTo lab7 Else t(s) = 1
If t(a) = 1 Then GoTo lab7 Else t(s) = 1
If t(w) = 1 Then GoTo lab7 Else t(s) = 1
If t(e) = 1 Then GoTo lab7 Else t(s) = 1
If t(n) = 1 Then GoTo lab7 Else t(s) = 1
MsgBox " SAW = " & vbTab & Space(2) & saw & Chr(13) _
& "+WAS = " & vbTab & "+" & was & Chr(13) _
& vbTab & String(4, "_") & Chr(13) _
& "SEEN = " & Space(2) & seen
lab7:
Next n
Next e
Next w
Next a
Next s
End Sub
Je ne suis pas sur de la méthode pour l'adapter à SEND+MORE=MONEY
Il suffit de retirer les lettres en double ?
Ce qui ferait
For s = 1 To 9
For e= 0 To 9
For n = 0 To 9
For d = 0 To 9
For m = 0 To 9
For o = 0 To 9
For r = 0 To 9
For y = 0 To 9
Je suis pas sur.
Quelqu'un pour m'aider, svp ?
PS: Hasco j'ai testé le code que tu cites dans ton lien, test OK
Merci
Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?
Re à tous
Alors j'ai fais ces modifs
LA macro mouline et il se passe rien
(j'ai attendu plus de 5 minutes )
Quelle erreur ai-je commise ?
Code:
Sub alphameticII()
'adpaté de QBasic
'source:http://www.angelfire.com/ak/magic119/sawwasseen.html
'SEND+MORE=MONEY
Dim t(0 To 9) As Integer
For s = 1 To 9
For e = 0 To 9
For n = 0 To 9
For d = 0 To 9
For m = 0 To 9
For o = 0 To 9
For r = 0 To 9
For y = 0 To 9
send = 1000 * s + 100 * e + 10 * n + d
more = 1000 * m + 100 * o + 10 * r + e
money = 10000 * m + 1000 * o + 100 * n + 10 * e + y
total = send + more
If money <> total Then GoTo lab7
For x = 0 To 9
t(0) = 0
Next x
If t(s) = 1 Then GoTo lab7 Else t(s) = 1
If t(e) = 1 Then GoTo lab7 Else t(s) = 1
If t(n) = 1 Then GoTo lab7 Else t(s) = 1
If t(d) = 1 Then GoTo lab7 Else t(s) = 1
If t(m) = 1 Then GoTo lab7 Else t(s) = 1
If t(o) = 1 Then GoTo lab7 Else t(s) = 1
If t(r) = 1 Then GoTo lab7 Else t(s) = 1
If t(y) = 1 Then GoTo lab7 Else t(s) = 1
MsgBox " SEND = " & vbTab & Space(2) & send & Chr(13) _
& "+MORE = " & vbTab & "+" & more & Chr(13) _
& vbTab & String(4, "_") & Chr(13) _
& "MONEY = " & Space(2) & money
lab7:
Next y
Next r
Next o
Next m
Next d
Next n
Next e
Next s
End Sub
Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?
Bonjour à tous,
Petite modif dans le code et tout marche bien:
Code:
For x = 0 To 9
t(x) = 0
Next x
If t(s) = 1 Then GoTo lab7 Else t(s) = 1
If t(e) = 1 Then GoTo lab7 Else t(e) = 1
If t(n) = 1 Then GoTo lab7 Else t(n) = 1
If t(d) = 1 Then GoTo lab7 Else t(d) = 1
If t(m) = 1 Then GoTo lab7 Else t(m) = 1
If t(o) = 1 Then GoTo lab7 Else t(o) = 1
If t(r) = 1 Then GoTo lab7 Else t(r) = 1
If t(y) = 1 Then GoTo lab7 Else t(y) = 1
Cette boucle est destinée à continuer la procédure si les totaux coincident mais que 2 lettres ont le même chiffre.
* t(x)=0 et pas t(0) pour mettre à 0 la table t
* Pour chaque lettre on met 1 dans l'index correspondant au chiffre s'il est à 0 pour indiquer qu'il est utilisé. S'il est déjà à 1, cela signifie que le chiffre est en double en on continue en LAB7: pour rechercher une autre combinaison.
* Il faut donc mettre t(chaque lettre) en fin d'instruction et pas toujours t(s).
Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?
Bonjour à tous,
Pour mouliner, ça mouline....
Mouliner pour mouliner, peut-être serait-il intéressant d'envoyer sur une cellule les résultats successifs..... histoire de voir la progression... une idée...