Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Recherche une boucle !

Recherche une boucle !

37 réponses
Avatar
garnote
Bonjour le monde,

SEND + MORE = MONEY

Le jeu consiste à remplacer chaque lettre par un nombre entier
(de 0 à 9) de telle sorte qu'aucune lettre n'ait la même valeur.
De plus, on ne doit pas attribuer à la première lettre des
mots la valeur 0. Il faut alors que la somme soit correcte.
Je crois que la solution :
S=9, E=5, N=6, D=7, M=1, O=0, R=8 et Y=2
est unique!
Peut-on obtenir ce résultat avec une macro?

Modeste début :
(1000s + 100e + 10n + d) + (1000m + 100o + 10r + e) =
10000m + 1000o +100n + 10e + y
Mais là, comment « boucler » cette patente-là en tenant compte
des restrictions précédentes ?
Moi je déclare forfait !

Allez, éblouissez-moi :-)))

Serge
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3 4
Avatar
garnote
Et comme les lettres SENDMORY ont toutes
des valeurs différentes, c'est donc dire que
28 <= S+E+N+D+M+O+R+Y <= 44.
Alors si on remplaçait les tests de comparaison
entre lettres ( S<>E, S<>N, S<>D, .... ) par :
t=S+E+N+D+M+O+R+Y
if t <D and t >( then
...

Ça irait plus vite ?

Serge



"RaMa" a écrit dans le message de news:

bonjour serge

8'24"
La méthode est frustre mais explore toutes les combinaisons (111111110)!!
RaMa

"garnote" a écrit dans le message de
news:Bbpsc.16473$
Attendu cinq minutes et pas encore de réponse de
vos macros ! Combien de temps de par che vous :-)
pour obtenir la réponse ?
Ai trouvé ça :

http://clip.dia.fi.upm.es/~vocal/public_info/seminar_notes/node13.html

smm :-
X = [S,E,N,D,M,O,R,Y],
X :: 0 .. 9,
M #> 0,
S #> 0,
1000*S + 100*E + 10*N + D +
1000*M + 100*O + 10*R + E # > > 10000*M + 1000*O + 100*N + 10*E + Y,
alldistinct(X),
labeling(X),
write(X).


Serge



"docm" a écrit dans le message de news:
#
Bonjour garnote.

Voici une facon simple, naturelle et rapide.

Sub Depart_Send_More()
Dim bc
Dim j0, j1, j2, j3, j4, j5, j6, j7
Dim mot0, mot1, mot2, mot3, mot4, mot5, mot6, mot7

bc = "0123456789"

For j0 = 1 To Len(bc)
mot0 = Mid(bc, j0, 1)
For j1 = 1 To Len(bc)
If j1 <> j0 Then
mot1 = Mid(bc, j1, 1)
For j2 = 1 To Len(bc)
If j2 <> j0 And j2 <> j1 Then
mot2 = Mid(bc, j2, 1)
For j3 = 1 To Len(bc)
If j3 <> j0 And j3 <> j1 And j3 <> j2 Then
mot3 = Mid(bc, j3, 1)
For j4 = 1 To Len(bc)
If j4 <> j0 And j4 <> j1 And j4 <> j2 And j4 <> j3 Then
mot4 = Mid(bc, j4, 1)
For j5 = 1 To Len(bc)
If j5 <> j0 And j5 <> j1 And j5 <> j2 And j5 <> j3 And j5 <>
j4


Then
mot5 = Mid(bc, j5, 1)
For j6 = 1 To Len(bc)
If j6 <> j0 And j6 <> j1 And j6 <> j2 And j6 <> j3 And j6
<>



j4
And j6 <> j5 Then
mot6 = Mid(bc, j6, 1)
For j7 = 1 To Len(bc)
If j7 <> j0 And j7 <> j1 And j7 <> j2 And j7 <> j3 And
j7



<>
j4 And j7 <> j5 And j7 <> j6 Then

mot7 = mot0 & mot1 & mot2 & mot3 & mot4 & mot5 & mot6 &
Mid(bc, j7, 1)
Dim result
result = VerifierCeNot(mot7)

End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
Next
Debug.Print "Terminé"

End Sub

Function VerifierCeNot(bc)
Static Solution
Dim b, c, n
Dim x

If (1000 * Mid(bc, 1, 1) + 100 * Mid(bc, 2, 1) + 10 * Mid(bc, 3, 1) +
Mid(bc, 4, 1)) + (1000 * Mid(bc, 5, 1) + 100 * Mid(bc, 6, 1) + 10 *
Mid(bc,

7, 1) + Mid(bc, 2, 1)) = 10000 * Mid(bc, 5, 1) + 1000 * Mid(bc, 6, 1)
+



100
* Mid(bc, 3, 1) + 10 * Mid(bc, 2, 1) + Mid(bc, 8, 1) Then

Solution = Solution + 1
Debug.Print "Solution"; Solution; "- ";
Debug.Print Mid(bc, 1, 1); Mid(bc, 2, 1); Mid(bc, 3, 1); Mid(bc, 4,
1);



"
+
"; Mid(bc, 5, 1); Mid(bc, 6, 1); Mid(bc, 7, 1); Mid(bc, 2, 1); " = ";
Mid(bc, 5, 1); Mid(bc, 6, 1); Mid(bc, 3, 1); Mid(bc, 2, 1) + Mid(bc,
8,



1)

End If

End Function

Amicalement.

"garnote" wrote in message
news:pcasc.5289$
Bonjour le monde,

SEND + MORE = MONEY

Le jeu consiste à remplacer chaque lettre par un nombre entier
(de 0 à 9) de telle sorte qu'aucune lettre n'ait la même valeur.
De plus, on ne doit pas attribuer à la première lettre des
mots la valeur 0. Il faut alors que la somme soit correcte.
Je crois que la solution :
S=9, E=5, N=6, D=7, M=1, O=0, R=8 et Y=2
est unique!
Peut-on obtenir ce résultat avec une macro?

Modeste début :
(1000s + 100e + 10n + d) + (1000m + 100o + 10r + e) > > > > 10000m + 1000o +100n + 10e + y
Mais là, comment « boucler » cette patente-là en tenant compte
des restrictions précédentes ?
Moi je déclare forfait !

Allez, éblouissez-moi :-)))

Serge



















Avatar
Daniel.M
Bien.

T'as vu ma réponse à ton message "Drôle de question".

Salutations,

Daniel M.

"garnote" wrote in message
news:lhqsc.16480$

Salut Daniel,

Yep! c'est parfait ainsi. 21 petites secondes.

Serge



"Daniel.M" a écrit dans le message de
news: edR$
Salut Sergio,

Il y avait un bug.

For j0 = 1 To k
bcA(j0) = k - 1
Next j0

doit être remplacé par :

For j0 = 1 To k
bcA(j0) = j0 - 1
Next j0


Sinon le tableau bcA() sera peuplé de 9 alors qu'on veut de 0 à 9.

Salutations,

Daniel M.








Avatar
garnote
Sur une plage de 10 860 cellules, ta version fait
ça en 2,5 s et la mienne en 10 s.

Serge


"Daniel.M" a écrit dans le message de
news: e#
Bien.

T'as vu ma réponse à ton message "Drôle de question".

Salutations,

Daniel M.

"garnote" wrote in message
news:lhqsc.16480$

Salut Daniel,

Yep! c'est parfait ainsi. 21 petites secondes.

Serge



"Daniel.M" a écrit dans le message de
news: edR$
Salut Sergio,

Il y avait un bug.

For j0 = 1 To k
bcA(j0) = k - 1
Next j0

doit être remplacé par :

For j0 = 1 To k
bcA(j0) = j0 - 1
Next j0


Sinon le tableau bcA() sera peuplé de 9 alors qu'on veut de 0 à 9.

Salutations,

Daniel M.












Avatar
garnote
Mais au fait, pourquoi t1 = GetTickCount
plutôt que t1 = Time ... ?

Serge



"garnote" a écrit dans le message de news:
Efrsc.16497$
Sur une plage de 10 860 cellules, ta version fait
ça en 2,5 s et la mienne en 10 s.

Serge


"Daniel.M" a écrit dans le message de
news: e#
Bien.

T'as vu ma réponse à ton message "Drôle de question".

Salutations,

Daniel M.

"garnote" wrote in message
news:lhqsc.16480$

Salut Daniel,

Yep! c'est parfait ainsi. 21 petites secondes.

Serge



"Daniel.M" a écrit dans le message
de



news: edR$
Salut Sergio,

Il y avait un bug.

For j0 = 1 To k
bcA(j0) = k - 1
Next j0

doit être remplacé par :

For j0 = 1 To k
bcA(j0) = j0 - 1
Next j0


Sinon le tableau bcA() sera peuplé de 9 alors qu'on veut de 0 à 9.

Salutations,

Daniel M.
















Avatar
Daniel.M
Pour être plus précis dans le calcul du temps (time ne retourne que les
secondes). Rien de plus.

Avec des grandes plages, ça devient moins nécessaire mais c'est quand même
plaisant d'avoir des mesures plus fines. AMA, si on peut compter au millième de
seconde aussi facilement (une petite déclaration), ça vaut la peine.

Daniel M.

"garnote" wrote in message
news:jhrsc.16498$
Mais au fait, pourquoi t1 = GetTickCount
plutôt que t1 = Time ... ?

Serge



Avatar
FxM
Bonsoir,

Pour limiter les boucles :

De part l'énoncé M = 1 et S=9 ou S=8 car :
SEND + MORE = MONEY
M ne peut être 0 (contrainte)

M ne peut être 2 car il faudrait arriver à 20000 au moins. Donc au moins
un nombre devrait avoir 5 chiffres, or les deux ont 4 chiffres. Leur
somme ne saurait dépasser 9753 + 8642 -> 18??? ==> M = 1
Donc, pour avoir X??? + 1??? = 1???? X ne peut être que 9 ou 8.

@+
FxM







Bonjour le monde,

SEND + MORE = MONEY

Le jeu consiste à remplacer chaque lettre par un nombre entier
(de 0 à 9) de telle sorte qu'aucune lettre n'ait la même valeur.
De plus, on ne doit pas attribuer à la première lettre des
mots la valeur 0. Il faut alors que la somme soit correcte.
Je crois que la solution :
S=9, E=5, N=6, D=7, M=1, O=0, R=8 et Y=2
est unique!
Peut-on obtenir ce résultat avec une macro?

Modeste début :
(1000s + 100e + 10n + d) + (1000m + 100o + 10r + e) > 10000m + 1000o +100n + 10e + y
Mais là, comment « boucler » cette patente-là en tenant compte
des restrictions précédentes ?
Moi je déclare forfait !

Allez, éblouissez-moi :-)))

Serge







Avatar
garnote
Et connaissez-vous cet énigmatique diagramme
découvert par Mitchell Feigenbaum avec une simple
calculatrice en 1975 ?
C'est cet olibrius qui a inspiré le personnage du mathématicien
dans «Parc jurassique». Spielberg a même déniché un acteur
qui ressemble à Feigenbaum!

:-)))

Sub Bifurcations_En_Cascade()
'Faire un nuage de petits points
'avec les données obtenues
'Échelle X : de 2,8 à 4
'Échelle Y : de 0 à 1
Application.ScreenUpdating = False
Dim x(50000) As Double
Dim y(50000) As Double
x(0) = 0.5
u = 0
r = 0
For lam = 2.8 To 4 Step 0.002
u = u + 1
For i = 1 To 1000
x(i) = lam * x(i - 1) * (1 - x(i - 1))
Next i
fin = (50 * (u - 1)) + 1
g = 0
For j = fin To fin + 49
g = g + 1
y(j) = x(950 + g)
Next j
Next lam
For j = 1 To 50 * u
Cells(1 + j, 2).Value = y(j)
Next j
For k = 2.8 To 4 Step 0.002
r = r + 1
debut = (r - 1) * 50 + 1
For i = debut To debut + 49
Cells(1 + i, 1).Value = k
Next i
Next k
End Sub


Serge
Avatar
RaMa
Bonjoir FxM

effectivement avec tes boucles retaillées
on passe à 13"
Salutations
RaMa

"FxM" a écrit dans le message de
news:
Bonsoir,

Pour limiter les boucles :

De part l'énoncé M = 1 et S=9 ou S=8 car :
SEND + MORE = MONEY
M ne peut être 0 (contrainte)

M ne peut être 2 car il faudrait arriver à 20000 au moins. Donc au moins
un nombre devrait avoir 5 chiffres, or les deux ont 4 chiffres. Leur
somme ne saurait dépasser 9753 + 8642 -> 18??? ==> M = 1
Donc, pour avoir X??? + 1??? = 1???? X ne peut être que 9 ou 8.

@+
FxM







Bonjour le monde,

SEND + MORE = MONEY

Le jeu consiste à remplacer chaque lettre par un nombre entier
(de 0 à 9) de telle sorte qu'aucune lettre n'ait la même valeur.
De plus, on ne doit pas attribuer à la première lettre des
mots la valeur 0. Il faut alors que la somme soit correcte.
Je crois que la solution :
S=9, E=5, N=6, D=7, M=1, O=0, R=8 et Y=2
est unique!
Peut-on obtenir ce résultat avec une macro?

Modeste début :
(1000s + 100e + 10n + d) + (1000m + 100o + 10r + e) > > 10000m + 1000o +100n + 10e + y
Mais là, comment « boucler » cette patente-là en tenant compte
des restrictions précédentes ?
Moi je déclare forfait !

Allez, éblouissez-moi :-)))

Serge









Avatar
docm
Bonjour Daniel.

Merci pour cette optimisation de mon code.
Au départ j'avais 41988 millièmes de secs.

Après avoir typé les variables,
Terminé en 36622 millièmes de secs.

Après avoir enlevé les 8 instructions mid(), je suis descendu encore plus:
Terminé en 5358 millièmes de secs.

Amicalement.

"Daniel.M" wrote in message
news:
Salut Sergio,

Attendu cinq minutes et pas encore de réponse de
vos macros ! Combien de temps de par che vous :-)
pour obtenir la réponse ?


Voilà bien une illustration de l'importance des déclarations de variables!

Cette variation 'typée' du code de 'docm' roule en moins de 20 secondes
chez moi

(vieille bécane à 450 MHz).

Salutations,

Daniel M.


Declare Function GetTickCount Lib "kernel32" () As Long

Sub Depart_Send_More3()
Dim k As Integer
Dim j0%, j1%, j2%, j3%, j4%, j5%, j6%, j7%
Dim bcA() As Integer, motA() As Long
Dim t1&, t2&

t1 = GetTickCount ' chrono initial

k = 10
ReDim bcA(1 To k)
For j0 = 1 To k
bcA(j0) = k - 1
Next j0

ReDim motA(1 To k)


For j0 = 1 To k
motA(1) = bcA(j0)
For j1 = 1 To k
If j1 <> j0 Then
motA(2) = bcA(j1)
For j2 = 1 To k
If j2 <> j0 And j2 <> j1 Then
motA(3) = bcA(j2)
For j3 = 1 To k
If j3 <> j0 And j3 <> j1 And j3 <> j2 Then
motA(4) = bcA(j3)
For j4 = 1 To k
If j4 <> j0 And j4 <> j1 And j4 <> j2 And j4 <> j3 Then
motA(5) = bcA(j4)
For j5 = 1 To k
If j5 <> j0 And j5 <> j1 And j5 <> j2 And j5 <> j3 And j5 <> j4 Then
motA(6) = bcA(j5)
For j6 = 1 To k
If j6 <> j0 And j6 <> j1 And j6 <> j2 And j6 <> j3 And j6 <> j4 _
And j6 <> j5 Then
motA(7) = bcA(j6)
For j7 = 1 To k
If j7 <> j0 And j7 <> j1 And j7 <> j2 And j7 <> j3 And j7 <> j4 _
And j7 <> j5 And j7 <> j6 Then
motA(8) = bcA(j7)

VerifierCeNot3 motA

End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
Next

t2 = GetTickCount

Debug.Print "Terminé en "; t2 - t1 & " millièmes de secs."

End Sub


Sub VerifierCeNot3(Fact() As Long)
Static Solution

If Fact(1) <> 0 And Fact(5) <> 0 Then
If 1000 * Fact(1) + 100 * Fact(2) + 10 * Fact(3) + _
Fact(4) + 1000 * Fact(5) + 100 * Fact(6) + _
10 * Fact(7) + Fact(2) = _
10000 * Fact(5) + 1000 * Fact(6) + _
100 * Fact(3) + 10 * Fact(2) + Fact(8) Then
Solution = Solution + 1
Debug.Print "Solution"; Solution; "- ";
Debug.Print Fact(1); Fact(2); Fact(3); _
Fact(4); " + "; Fact(5); Fact(6); _
Fact(7); Fact(2); " = "; Fact(5); _
Fact(6); Fact(3); Fact(2); Fact(8)
End If
End If
End Sub





Avatar
FxM

Bonjoir FxM
Ouh là, JièL va te demander des royalties ...

et puis tu as oublié le (c) ;o)

@+
FxM

1 2 3 4