Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Recherche accélérateur de macro

5 réponses
Avatar
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

5 réponses

Avatar
FdeCourt
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" wrote:
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


Avatar
Tatanka
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" a écrit dans le message de news:

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" wrote:
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


Avatar
isabelle
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






















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























Avatar
FdeCourt
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" wrote:
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 -