Recherche accélérateur de macro

Le
Tatanka
Bonjour,

On définit la « persistance » d'un nombre entier plus grand que 9
comme étant le nombre d'étapes requis pour obtenir un nombre
contenant un seul chiffre en appliquant la règle suivante :
1) Multiplier tous les chiffres du nombre initial
2) Multiplier tous les chiffres du nombre obtenu en 1)
3) Multiplier tous les chiffres du nombre obtenu en 2)
4) Multiplier tous les chiffres du nombre obtenu en 3)


Exemples :
15 a une persistance de 1 car : 15, 5
99 a une persistance de 2 car : 99, 81, 8
8139 a une persistance de 3 car : 8139, 216, 12, 2
7155 a une persistance de 4 car : 7155, 175, 35, 15, 5

Ma macro cherche
a) le plus petit nombre de persistance p égale à 1
b) le plus petit nombre de persistance p égale à 2
c) le plus petit nombre de persistance p égale à 3

k) le plus petit nombre de persistance égale à 11

Elle fonctionne correctement mais pour p = 8, ça
lui prend 8'40''. Je n'ai pas eu la patience d'attendre
la réponse pour p>8. Auriez-vous des idées pour la
rendre plus rapide ?
Vous trouverez mon classeur à cette adresse :
http://cjoint.com/?dtoInHv0u2
et voici la macro :
Sub Persistance()
'Cette macro trouve le plus petit nombre dont
'la persistance est égale à la valeur de A2.
Dim n(1 To 12)
Dim k As Double
t1 = Time
k = 9
Do
k = k + 1
p = 1
j = 1
n(1) = k
Do
j = j + 1
For i = 1 To Len(n(j - 1))
p = p * Mid(n(j - 1), i, 1)
Next i
n(j) = p
If Len(p) = 1 Then Exit Do
p = 1
Loop
If j = [a2] + 1 Then
Cells(2, 2) = k
MsgBox Format(Time - t1, "hh:mm:ss")
Exit Sub
End If
Loop
End Sub

Serge
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FdeCourt
Le #5190591
Hello,

Sans toucher à ton code, je rajoutereai une variable dans laquelle je
mettrais la valeur de A2, pour que lorsque la macro fait ses calcul,
elle n'ait pas besoin d'aller voir le contenu du classeur :
Cela m'a pris 1 minute 03 pour faire le caclul avec p=8

Sub Persistance()
'Cette macro trouve le plus petit nombre dont
'la persistance est égale à la valeur de A2.
Dim n(1 To 12)
Dim k As Double
t1 = Time
k = 9
valA2 = [A2].Value
Do
k = k + 1
p = 1
j = 1
n(1) = k
Do
j = j + 1
For i = 1 To Len(n(j - 1))
p = p * Mid(n(j - 1), i, 1)
Next i
n(j) = p
If Len(p) = 1 Then Exit Do
p = 1
Loop
If j = valA2 + 1 Then
Cells(2, 2) = k
MsgBox Format(Time - t1, "hh:mm:ss")
Exit Sub
End If
Loop
End Sub



On 19 mar, 14:36, "Tatanka"
Bonjour,

On définit la « persistance » d'un nombre entier plus grand que 9
comme étant le nombre d'étapes requis pour obtenir un nombre
contenant un seul chiffre en appliquant la règle suivante :
1) Multiplier tous les chiffres du nombre initial
2) Multiplier tous les chiffres du nombre obtenu en 1)
3) Multiplier tous les chiffres du nombre obtenu en 2)
4) Multiplier tous les chiffres du nombre obtenu en 3)
...

Exemples :
15 a une persistance de 1 car : 15,  5
99 a une persistance de 2 car : 99, 81, 8
8139 a une persistance de 3 car : 8139, 216, 12, 2
7155 a une persistance de 4 car : 7155, 175, 35, 15, 5

Ma macro cherche
a) le plus petit nombre de persistance p égale à 1
b) le plus petit nombre de persistance p égale à 2
c) le plus petit nombre de persistance p égale à 3
...
k) le plus petit nombre de persistance égale à 11

Elle fonctionne correctement mais pour p = 8, ça
lui prend 8'40''. Je n'ai pas eu la patience d'attendre
la réponse pour p>8. Auriez-vous des idées pour la
rendre plus rapide ?
Vous trouverez mon classeur à cette adresse :http://cjoint.com/?dtoInHv0 u2
et voici la macro :
Sub Persistance()
    'Cette macro trouve le plus petit nombre dont
    'la persistance est égale à la valeur de A2.
    Dim n(1 To 12)
    Dim k As Double
    t1 = Time
    k = 9
    Do
        k = k + 1
        p = 1
        j = 1
        n(1) = k
        Do
            j = j + 1
            For i = 1 To Len(n(j - 1))
                p = p * Mid(n(j - 1), i, 1)
            Next i
            n(j) = p
            If Len(p) = 1 Then Exit Do
            p = 1
        Loop
        If j = [a2] + 1 Then
            Cells(2, 2) = k
            MsgBox Format(Time - t1, "hh:mm:ss")
            Exit Sub
        End If
     Loop
End Sub

Serge


Tatanka
Le #5190521
Salut,

Pas croyable qu'un si petit changement me fasse passer de 8'40'' à 3'50''.
Voici les plus petits nombres pour chaque persistance :
1 10
2 25
3 39
4 77
5 679
6 6 788
7 68 889
8 2 677 889
9 26 888 999
10 3 778 888 999
11 277 777 788 888 899
Je n'ose imaginer le temps requis pour trouver le 11 ième nombre !
Il n'existe pas de nombre inférieur à 10^50 avec une persistance
supérieure à 11 ;-)

http://www.mathews-archive.com/digit-related-numbers/persistence.html

Serge


"F12deCourt"
Hello,

Sans toucher à ton code, je rajoutereai une variable dans laquelle je
mettrais la valeur de A2, pour que lorsque la macro fait ses calcul,
elle n'ait pas besoin d'aller voir le contenu du classeur :
Cela m'a pris 1 minute 03 pour faire le caclul avec p=8

Sub Persistance()
'Cette macro trouve le plus petit nombre dont
'la persistance est égale à la valeur de A2.
Dim n(1 To 12)
Dim k As Double
t1 = Time
k = 9
valA2 = [A2].Value
Do
k = k + 1
p = 1
j = 1
n(1) = k
Do
j = j + 1
For i = 1 To Len(n(j - 1))
p = p * Mid(n(j - 1), i, 1)
Next i
n(j) = p
If Len(p) = 1 Then Exit Do
p = 1
Loop
If j = valA2 + 1 Then
Cells(2, 2) = k
MsgBox Format(Time - t1, "hh:mm:ss")
Exit Sub
End If
Loop
End Sub



On 19 mar, 14:36, "Tatanka"
Bonjour,

On définit la « persistance » d'un nombre entier plus grand que 9
comme étant le nombre d'étapes requis pour obtenir un nombre
contenant un seul chiffre en appliquant la règle suivante :
1) Multiplier tous les chiffres du nombre initial
2) Multiplier tous les chiffres du nombre obtenu en 1)
3) Multiplier tous les chiffres du nombre obtenu en 2)
4) Multiplier tous les chiffres du nombre obtenu en 3)
...

Exemples :
15 a une persistance de 1 car : 15, 5
99 a une persistance de 2 car : 99, 81, 8
8139 a une persistance de 3 car : 8139, 216, 12, 2
7155 a une persistance de 4 car : 7155, 175, 35, 15, 5

Ma macro cherche
a) le plus petit nombre de persistance p égale à 1
b) le plus petit nombre de persistance p égale à 2
c) le plus petit nombre de persistance p égale à 3
...
k) le plus petit nombre de persistance égale à 11

Elle fonctionne correctement mais pour p = 8, ça
lui prend 8'40''. Je n'ai pas eu la patience d'attendre
la réponse pour p>8. Auriez-vous des idées pour la
rendre plus rapide ?
Vous trouverez mon classeur à cette adresse :http://cjoint.com/?dtoInHv0u2
et voici la macro :
Sub Persistance()
'Cette macro trouve le plus petit nombre dont
'la persistance est égale à la valeur de A2.
Dim n(1 To 12)
Dim k As Double
t1 = Time
k = 9
Do
k = k + 1
p = 1
j = 1
n(1) = k
Do
j = j + 1
For i = 1 To Len(n(j - 1))
p = p * Mid(n(j - 1), i, 1)
Next i
n(j) = p
If Len(p) = 1 Then Exit Do
p = 1
Loop
If j = [a2] + 1 Then
Cells(2, 2) = k
MsgBox Format(Time - t1, "hh:mm:ss")
Exit Sub
End If
Loop
End Sub

Serge


isabelle
Le #5190491
bonjour Serge,

sans rien changé :
9 26888999 00:21:38

serait t'il possible d'utiliser les dernières valeurs de 8 par exemple pour démarrer le calcul pour 9 ?

isabelle


Bonjour,

On définit la « persistance » d'un nombre entier plus grand que 9
comme étant le nombre d'étapes requis pour obtenir un nombre
contenant un seul chiffre en appliquant la règle suivante :
1) Multiplier tous les chiffres du nombre initial
2) Multiplier tous les chiffres du nombre obtenu en 1)
3) Multiplier tous les chiffres du nombre obtenu en 2)
4) Multiplier tous les chiffres du nombre obtenu en 3)
...

Exemples :
15 a une persistance de 1 car : 15, 5
99 a une persistance de 2 car : 99, 81, 8
8139 a une persistance de 3 car : 8139, 216, 12, 2
7155 a une persistance de 4 car : 7155, 175, 35, 15, 5

Ma macro cherche
a) le plus petit nombre de persistance p égale à 1
b) le plus petit nombre de persistance p égale à 2
c) le plus petit nombre de persistance p égale à 3
...
k) le plus petit nombre de persistance égale à 11

Elle fonctionne correctement mais pour p = 8, ça
lui prend 8'40''. Je n'ai pas eu la patience d'attendre
la réponse pour p>8. Auriez-vous des idées pour la
rendre plus rapide ?
Vous trouverez mon classeur à cette adresse :
http://cjoint.com/?dtoInHv0u2
et voici la macro :
Sub Persistance()
'Cette macro trouve le plus petit nombre dont
'la persistance est égale à la valeur de A2.
Dim n(1 To 12)
Dim k As Double
t1 = Time
k = 9
Do
k = k + 1
p = 1
j = 1
n(1) = k
Do
j = j + 1
For i = 1 To Len(n(j - 1))
p = p * Mid(n(j - 1), i, 1)
Next i
n(j) = p
If Len(p) = 1 Then Exit Do
p = 1
Loop
If j = [a2] + 1 Then
Cells(2, 2) = k
MsgBox Format(Time - t1, "hh:mm:ss")
Exit Sub
End If
Loop
End Sub

Serge






















Tatanka
Le #5190431
Oui bonne idée.
Remplacer k = 9 par k = 2677889 dans la variante de FdeCourt.
Mais pour passer de 3 778 888 999 (persistance 10) à
277 777 788 888 899 (persistance 11), m'est avis que la neige
aura le temps de fondre ;-)

Serge



"isabelle" a écrit dans le message de news: %
bonjour Serge,

sans rien changé :
9 26888999 00:21:38

serait t'il possible d'utiliser les dernières valeurs de 8 par exemple pour démarrer le calcul pour 9 ?

isabelle


Bonjour,

On définit la « persistance » d'un nombre entier plus grand que 9
comme étant le nombre d'étapes requis pour obtenir un nombre
contenant un seul chiffre en appliquant la règle suivante :
1) Multiplier tous les chiffres du nombre initial
2) Multiplier tous les chiffres du nombre obtenu en 1)
3) Multiplier tous les chiffres du nombre obtenu en 2)
4) Multiplier tous les chiffres du nombre obtenu en 3)
...

Exemples :
15 a une persistance de 1 car : 15, 5
99 a une persistance de 2 car : 99, 81, 8
8139 a une persistance de 3 car : 8139, 216, 12, 2
7155 a une persistance de 4 car : 7155, 175, 35, 15, 5

Ma macro cherche
a) le plus petit nombre de persistance p égale à 1
b) le plus petit nombre de persistance p égale à 2
c) le plus petit nombre de persistance p égale à 3
...
k) le plus petit nombre de persistance égale à 11

Elle fonctionne correctement mais pour p = 8, ça
lui prend 8'40''. Je n'ai pas eu la patience d'attendre
la réponse pour p>8. Auriez-vous des idées pour la
rendre plus rapide ?
Vous trouverez mon classeur à cette adresse :
http://cjoint.com/?dtoInHv0u2
et voici la macro :
Sub Persistance()
'Cette macro trouve le plus petit nombre dont
'la persistance est égale à la valeur de A2.
Dim n(1 To 12)
Dim k As Double
t1 = Time
k = 9
Do
k = k + 1
p = 1
j = 1
n(1) = k
Do
j = j + 1
For i = 1 To Len(n(j - 1))
p = p * Mid(n(j - 1), i, 1)
Next i
n(j) = p
If Len(p) = 1 Then Exit Do
p = 1
Loop
If j = [a2] + 1 Then
Cells(2, 2) = k
MsgBox Format(Time - t1, "hh:mm:ss")
Exit Sub
End If
Loop
End Sub

Serge























FdeCourt
Le #5190391
En restant sur 1 minutes pour faire la persistance 8, il faudrait 50
jour pour faire la persistance 11, alors 1 jour de plus ou de
moins.....


On 19 mar, 17:19, "Tatanka"
Oui bonne idée.
Remplacer k = 9 par k = 2677889 dans la variante de FdeCourt.
Mais pour passer de 3 778 888 999 (persistance 10) à
277 777 788 888 899 (persistance 11), m'est avis que la neige
aura le temps de fondre ;-)

Serge

"isabelle" a écrit dans le message denews: %23uFBaXdiIHA.3__BEGIN_ MASK_n#9g02mG7!__...__END_MASK_i?a63jfAD$



bonjour Serge,

sans rien changé :
9 26888999 00:21:38

serait t'il possible d'utiliser les dernières valeurs de 8 par exemple pour démarrer le calcul pour 9 ?

isabelle

Bonjour,

On définit la « persistance » d'un nombre entier plus grand que 9
comme étant le nombre d'étapes requis pour obtenir un nombre
contenant un seul chiffre en appliquant la règle suivante :
1) Multiplier tous les chiffres du nombre initial
2) Multiplier tous les chiffres du nombre obtenu en 1)
3) Multiplier tous les chiffres du nombre obtenu en 2)
4) Multiplier tous les chiffres du nombre obtenu en 3)
...

Exemples :
15 a une persistance de 1 car : 15,  5
99 a une persistance de 2 car : 99, 81, 8
8139 a une persistance de 3 car : 8139, 216, 12, 2
7155 a une persistance de 4 car : 7155, 175, 35, 15, 5

Ma macro cherche
a) le plus petit nombre de persistance p égale à 1
b) le plus petit nombre de persistance p égale à 2
c) le plus petit nombre de persistance p égale à 3
...
k) le plus petit nombre de persistance égale à 11

Elle fonctionne correctement mais pour p = 8, ça
lui prend 8'40''. Je n'ai pas eu la patience d'attendre
la réponse pour p>8. Auriez-vous des idées pour la
rendre plus rapide ?
Vous trouverez mon classeur à cette adresse :
http://cjoint.com/?dtoInHv0u2
et voici la macro :
Sub Persistance()
    'Cette macro trouve le plus petit nombre dont
    'la persistance est égale à la valeur de A2.
    Dim n(1 To 12)
    Dim k As Double
    t1 = Time
    k = 9
    Do
        k = k + 1
        p = 1
        j = 1
        n(1) = k
        Do
            j = j + 1
            For i = 1 To Len(n(j - 1))
                p = p * Mid(n(j - 1), i, 1)
            Next i
            n(j) = p
            If Len(p) = 1 Then Exit Do
            p = 1
        Loop
        If j = [a2] + 1 Then
            Cells(2, 2) = k
            MsgBox Format(Time - t1, "hh:mm:ss")
            Exit Sub
        End If
     Loop
End Sub

Serge- Masquer le texte des messages précédents -



- Afficher le texte des messages précédents -




Publicité
Poster une réponse
Anonyme