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

Staple1600

XLDnaute Barbatruc
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 ;) )
 

VIARD

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

Bonjour à tous.

C'est truc que je ne connaissais pas.
J'ai effectué la modif proposé par Gaêl.
Ca marche. durée 1 à 3 secondes.

Salutation à tous

Jean-Paul
 

Staple1600

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

Bonjour jeanpierre, VIARD


VIARD: moi aussi je suis sous Excel 2000

et avec les modifs de Gael , je n'obtiens aucun résultat au bout de 3 secondes

Je teste avec cette macro:

Code:
Sub alphameticSEND_MORE() '---> 'erreur ou pas ?
'adpaté de QBasic
'source:http://www.angelfire.com/ak/magic119/sawwasseen.html
'SEND+MORE=MONEY

Application.ScreenUpdating = False
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(x) = 0
Next x
'les modifs de Gael
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
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
Application.ScreenUpdating = True
End Sub
 

Gael

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

Re,

Ci-joint le fichier de Staple avec la macro "alphameticSEND_MORE" modifiée pour réduire le temps de réponse:

la table T(0 to 9) est gérée pendant l'exécution pour éviter de chercher des solutions dont on sait à l'avance qu'elles ne seront pas valables, le chiffre étant déjà utilisé.

Pour info, avec la macro précédente, j'obtenais la solution en 1min45sec et maintenant en 3 secondes.

Edit: la variable m va de 1 à 9 et non pas de 0 à 9 pour éviter les solutions triviales ou la première lettre de MORE et de MONEY =0

@+

Gael
 

Pièces jointes

  • alphameticTEST_V1.xls
    53.5 KB · Affichages: 114
Dernière édition:

Staple1600

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

Re à tous

Bravo Gael (Cette fois c'est bon cela fonctionne)

Moi c'est des cours de maths qu'il me faudrait!

Vous avez été voir ce site ?
JavaScript Cryptarithm Solver

Il génére le code QBasic pour résoudre le cryptarythme passé en paramètre ! (personnellement ca m'a bluffé )

Et si on essayait de faire la même chose en VBA ? :D
 

VIARD

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

Salut Staple1600 Jean-Pierre

Pas de problème, c'est le bon programme que j'ai utilisé.
Sub alphameticSEND_MORE

Suivant le calcul la durée varie, mais ça marche.

Salutation

Jean-Paul
 

Gael

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

Bonsoir à tous,

En fait c'est parceque je prends souvent des Ti'punch en souvenir de la Martinique.

Si vous voulez essayer, pas de problème rendez-vous à Lorient, je vous donnerai la recette et on passera une super mini soirée XLD.

@+

Gael
 

Staple1600

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

Bonsoir à tous



Un petit HS (qui pourrait être utile à tous, surtout que c'est le week-end)



Gael:


Quelle est ta recette du Ti'punch ?

Et veux-tu nous la faire partager, stp ?
 

Gael

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

Bonsoir à tous,

1 mesure de sirop de sucre de canne
3 mesures de rhum blanc (50° ou 55°)
1 zeste de citron vert avec un peu de jus
quelques glaçons.

A déguster lentement et de préférence après avoir terminé les macros pour XLD.

Mais si vous êtes de passage à Lorient, l'invitation tient toujours :)

@+

Gael
 

Statistiques des forums

Discussions
312 493
Messages
2 088 956
Membres
103 990
dernier inscrit
lamiadebz