[VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

[Staple1600]

Bonjour à tous


Suite au post sur la génération de mots (consonnes/voyellles)
je me suis remémoré ce jeu mathématique:

Le cryptarythme ou alphamétique

Exemple:

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.

J'ai voulu voir sur le net s'il existant ce genre de classeur.
(soit en VBA, soit en formules)

A ma grande surprise je n'en ai pas trouvé.

Et vous ?

Qui serait partant pour essayer de créer un classeur de ce type
1) qui générerait des cryptarythmes
1) résolverait certains cryptarythmes prédifinis.

J'espère que les matheux du forum se manifesteront car cela semble ardu
(en tout cas pour moi 😉 )

 

[Guest]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Hello Staple,

Je viens d'aller consulter le lien sur l'alaméthique: passionant ce genre de défi.

Décidement tu nous occupes l'esprit. J'espère qu'un algorythmicien matheux pourra nous donner des pistes.

A+

 

[Guest]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Staple,

J'ai trouvé ceci en faisant une recherche google avec "send more money" :

[HS] SEND + MORE = MONEY temps < 1 ms, entraide, FAQ, conseils, avis, Excel, Microsoft Office

A+

 

[Staple1600]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Bonsoir Hasco


Bravo sur ce coup là

j'avais essayer plusieurs mots-clés sauf ceux-là

Le pire c'est je n'avais pas vu ta réponse

(le fil étant passé ne deuxième page)

Quelle perte de temps (lol)

 

[Staple1600]

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

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

 

[Staple1600]

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 ?

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

 

[Staple1600]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Bonjour à tous


Un petit up matinal.


Si un vbaiste passe par ici , pourrait-il me dire, svp, s'il y a une erreur dans le code posté dans mon précédent message.

(Sachant que le code VBA qui résoud SAW+WAS=SEEN fonctionne lui )

Merci.

 

[Staple1600]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Re bonjour


Petit up d'après-déjeuner 🙂

Personne dans les parages pour un petit coup de main?

Je n'arrive pas à savoir si le code VBA est erroné

ou s'il faut un temps très long pour obtenir le résultat.

 

[Guest]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Hello Staple,

j'ai regardé, mais je ne comprends pas non plus.

A++++

 

[Gael]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Bonjour à tous,

Petite modif dans le code et tout marche bien:

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).

@+

Gael

 

[Staple1600]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Bonjour Hasco



Peux-tu tester le classeur ci-joint, stp ?

(car j'ai un vieux coucou)

Peut-être que sur un PC récent, les macros s'exécuteront plus vite.

Merci.


PS: bien sur, tout autre personne qu'Hasco est autorisé à tester ce classeur (et même vivement encouragé à le faire 😉 )

 

[Guest]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Hello, Staple, Gael,

@Gael, ça marche pas mieux chez moi, ça boucle sans fin.

A bientôt

 

[Guest]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Hello Stapple,

Celle-ci :alphameticQB_SM_OK met 12 secondes alors que les autres sont quasi instantannée. (pc ATHLON de 2004)


A+

 

[Staple1600]

Re : [VBA] Générateur/SOLVER de cryptarythme/alphamétique comment faire?

Re


Juste pour saluer Gael que je n'avais pas vu.


Je teste tes modifs.


EDITION: modifs apporté dans Sub alphameticSEND_MORE

Comme Hasco, la macro mouline

Je suis obligé de faire CRTL+PAUSE

 

[jeanpierre]

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...

Restera ensuite le Ctrl Pause ou Echap....

A suivre.

Jean-Pierre