Recherche une boucle !

37 réponses

garnote

24/05/2004 à 01:11

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

10 réponses

1 2 3 4

docm

24/05/2004 à 22:35

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#

Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:#nAGvLZQEHA.2644@TK2MSFTNGP12.phx.gbl...

Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23WRJkyYQEHA.556@tk2msftngp13.phx.gbl...

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" <rien@absent.net> wrote in message
news:pcasc.5289$J02.2300@edtnps84...

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

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#

Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

RaMa

24/05/2004 à 22:39

?..?
RaMa
"FxM" a écrit dans le message de
news:e$

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

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

@+
FxM

RaMa

24/05/2004 à 22:48

Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

ton debug en listait 25!!
Cela dit ton algorythme un vrai petit plaisir

Salutations

RaMa

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

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

ton debug en listait 25!!
Cela dit ton algorythme un vrai petit plaisir

Salutations

RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:OlUwn6cQEHA.3988@tk2msftngp13.phx.gbl...

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:#nAGvLZQEHA.2644@TK2MSFTNGP12.phx.gbl...

Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23WRJkyYQEHA.556@tk2msftngp13.phx.gbl...

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" <rien@absent.net> wrote in message
news:pcasc.5289$J02.2300@edtnps84...

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

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

docm

24/05/2004 à 23:07

"RaMa" wrote in message
news:

Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" a écrit dans le message de
news:
Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:e3vgLCdQEHA.2716@tk2msftngp13.phx.gbl...

Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:OlUwn6cQEHA.3988@tk2msftngp13.phx.gbl...

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:#nAGvLZQEHA.2644@TK2MSFTNGP12.phx.gbl...

Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23WRJkyYQEHA.556@tk2msftngp13.phx.gbl...

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" <rien@absent.net> wrote in message
news:pcasc.5289$J02.2300@edtnps84...

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

Vous avez filtré cet utilisateur ! Consultez son message

"RaMa" wrote in message
news:

Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" a écrit dans le message de
news:
Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

RaMa

24/05/2004 à 23:42

elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" a écrit dans le message de
news:%23%

"RaMa" wrote in message
news:
Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" a écrit dans le message de
news:
Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23%23dYVMdQEHA.3708@TK2MSFTNGP10.phx.gbl...

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:e3vgLCdQEHA.2716@tk2msftngp13.phx.gbl...

Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:OlUwn6cQEHA.3988@tk2msftngp13.phx.gbl...

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:#nAGvLZQEHA.2644@TK2MSFTNGP12.phx.gbl...

Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23WRJkyYQEHA.556@tk2msftngp13.phx.gbl...

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" <rien@absent.net> wrote in message
news:pcasc.5289$J02.2300@edtnps84...

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

Vous avez filtré cet utilisateur ! Consultez son message

elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" a écrit dans le message de
news:%23%

"RaMa" wrote in message
news:
Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" a écrit dans le message de
news:
Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

docm

24/05/2004 à 23:50

-:)

"RaMa" wrote in message
news:

elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" a écrit dans le message de
news:%23%

"RaMa" wrote in message
news:
Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" a écrit dans le message de
news:
Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

-:)

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:eRi3OgdQEHA.2132@TK2MSFTNGP11.phx.gbl...

elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23%23dYVMdQEHA.3708@TK2MSFTNGP10.phx.gbl...

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:e3vgLCdQEHA.2716@tk2msftngp13.phx.gbl...

Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:OlUwn6cQEHA.3988@tk2msftngp13.phx.gbl...

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:#nAGvLZQEHA.2644@TK2MSFTNGP12.phx.gbl...

Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23WRJkyYQEHA.556@tk2msftngp13.phx.gbl...

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" <rien@absent.net> wrote in message
news:pcasc.5289$J02.2300@edtnps84...

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

Vous avez filtré cet utilisateur ! Consultez son message

-:)

"RaMa" wrote in message
news:

elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" a écrit dans le message de
news:%23%

"RaMa" wrote in message
news:
Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" a écrit dans le message de
news:
Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

docm

25/05/2004 à 00:35

J'ai bien aimé ton choix de variables s,e,n,d,m,o,r,e...
Brillant.

"RaMa" wrote in message
news:

elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" a écrit dans le message de
news:%23%

"RaMa" wrote in message
news:
Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" a écrit dans le message de
news:
Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

J'ai bien aimé ton choix de variables s,e,n,d,m,o,r,e...
Brillant.

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:eRi3OgdQEHA.2132@TK2MSFTNGP11.phx.gbl...

elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23%23dYVMdQEHA.3708@TK2MSFTNGP10.phx.gbl...

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:e3vgLCdQEHA.2716@tk2msftngp13.phx.gbl...

Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:OlUwn6cQEHA.3988@tk2msftngp13.phx.gbl...

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:#nAGvLZQEHA.2644@TK2MSFTNGP12.phx.gbl...

Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23WRJkyYQEHA.556@tk2msftngp13.phx.gbl...

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" <rien@absent.net> wrote in message
news:pcasc.5289$J02.2300@edtnps84...

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

Vous avez filtré cet utilisateur ! Consultez son message

J'ai bien aimé ton choix de variables s,e,n,d,m,o,r,e...
Brillant.

"RaMa" wrote in message
news:

elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" a écrit dans le message de
news:%23%

"RaMa" wrote in message
news:
Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" a écrit dans le message de
news:
Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

garnote

25/05/2004 à 00:58

En voici deux autres :-)

ALORS + ALORS + NOUS + NOUS = LAVONS
DIX + PLUS + DEUX = DOUZE

Serge

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

J'ai bien aimé ton choix de variables s,e,n,d,m,o,r,e...
Brillant.

"RaMa" wrote in message
news:
elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" a écrit dans le message de
news:%23%

"RaMa" wrote in message
news:
Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" a écrit dans le message de
news:
Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

En voici deux autres :-)

ALORS + ALORS + NOUS + NOUS = LAVONS
DIX + PLUS + DEUX = DOUZE

Serge

"docm" <docmarti@spamcolba.net> a écrit dans le message de news:
OVLhd9dQEHA.556@tk2msftngp13.phx.gbl...

J'ai bien aimé ton choix de variables s,e,n,d,m,o,r,e...
Brillant.

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:eRi3OgdQEHA.2132@TK2MSFTNGP11.phx.gbl...

elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23%23dYVMdQEHA.3708@TK2MSFTNGP10.phx.gbl...

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:e3vgLCdQEHA.2716@tk2msftngp13.phx.gbl...

Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:OlUwn6cQEHA.3988@tk2msftngp13.phx.gbl...

Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" <PaSpam_rmarceau@free.fr> wrote in message
news:#nAGvLZQEHA.2644@TK2MSFTNGP12.phx.gbl...

Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"docm" <docmarti@spamcolba.net> a écrit dans le message de
news:%23WRJkyYQEHA.556@tk2msftngp13.phx.gbl...

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" <rien@absent.net> wrote in message
news:pcasc.5289$J02.2300@edtnps84...

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

Vous avez filtré cet utilisateur ! Consultez son message

En voici deux autres :-)

ALORS + ALORS + NOUS + NOUS = LAVONS
DIX + PLUS + DEUX = DOUZE

Serge

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

J'ai bien aimé ton choix de variables s,e,n,d,m,o,r,e...
Brillant.

"RaMa" wrote in message
news:
elles sont pas douteuses mais merdiques
manquait r<>y
Demain je demande ma retraite

Merci Docm
RaMa

"docm" a écrit dans le message de
news:%23%

"RaMa" wrote in message
news:
Bonsoir docm
Pour m=1 1 solution
pour M>=0 (hors énoncé certes) 31 Solutions

Ces 6 solutions me semblent douteuses:
3718+0457175 Le 5 ne peut représenter à la fois le R et le Y
3827+0458285 Idem
6418+0724142 Le 2 représente le Y et le R ??
6854+0728582 etc...
7536+0815351
7645+0816461

ton debug en listait 25!!

Cela dit ton algorythme un vrai petit plaisir

Merci.

Amicalement.

Salutations

RaMa

"docm" a écrit dans le message de
news:
Bonjour Rama.
Je crois plutôt que tu as trop de solutions.
Amicalement

"RaMa" wrote in message
news:#
Bonjour docm
Pour m=0
il manque 6 solutions!!
3718+0457175
3827+0458285
6418+0724142
6854+0728582
7536+0815351
7645+0816461
Salutations
RaMa

"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

JièL Goubert

25/05/2004 à 01:20

Bonjoir(c) FxM

;-))))))))))

Le 24/05/2004 22:33 vous nous disiez ceci :

Bonjoir FxM

Ouh là, JièL va te demander des royalties ...
et puis tu as oublié le (c) ;o)

@+
FxM

RaMa

25/05/2004 à 08:04

Bonjour JièL Goubert
Ok c'est combien de points pour un excel de vitesse

Salutations
RaMa

"JièL Goubert" a écrit dans le
message de news:Ovi$

Bonjoir(c) FxM

;-))))))))))

Le 24/05/2004 22:33 vous nous disiez ceci :

Bonjoir FxM

Ouh là, JièL va te demander des royalties ...
et puis tu as oublié le (c) ;o)

@+
FxM

1 2 3 4

Recherche une boucle !

10 réponses

Veuillez sélectionner un problème