Tableau dynamique VBA sur Excel 2010

Bonjour,

Voici une tite macro permettant de trouver tous les nombres "narcissiques" compris entre 1 et 10 000 000. Si un nombre n contient p chiffres, n = n1 n2 n3 ..... np, on dit qu'il est narcissique si n = n1^p + n2^p + n3^p + ... + np^p. Par exemple, 153 et 92 727 sont narcissiques car : 153 = 1^3 + 5^3 + 3^3 et 92 727 = 9^5 + 2^5 + 7^5 + 2^5 + 7^5. Voici ma macro :

Sub Nombres_Narcissiques()

Début = Timer

Columns("A:A").ClearContents

Application.ScreenUpdating = False

For n = 1 To 10000000

nc = Len(n)

For k = 1 To nc

s = s + Mid(n, k, 1) ^ nc

Next k

If n = s Then

i = i + 1

Cells(i, 1) = n

End If

s = 0

Next n

Application.ScreenUpdating = True

MsgBox "Durée du traitement: " & Timer - Début & " secondes."

End Sub

J'ai tenté de "l'accélérer" en passant par un tableau dynamique mais en vain. Sur ma machine, elle s'exécute en 83 secondes.

Question : Auriez-vous des suggestions pour la rendre plus rapide?

Bonne journée!

Serge

Bonjour,

En première analyse 2 améliorations :

• déclarer tes variables Long
• sortir du for si n est dépassé, inutile de continuer à calculer

Sub Nombres_Narcissiques()
    Dim Début As Single, n As Long, nc As Long, k As Long, s As Long, i As Long
    Dim tab_n(1 To 50)
    Début = Timer
    Columns("A:A").ClearContents
    Application.ScreenUpdating = False
    For n = 1 To 10000000
        nc = Len(Trim(n))
        For k = 1 To nc
            s = s + Mid(n, k, 1) ^ nc
            If s >= n Then Exit For
        Next k
        If n = s Then
            i = i + 1
            tab_n(i) = n
        End If
        s = 0
    Next n
    [A1:A50] = Application.Transpose(tab_n)
    MsgBox "Durée du traitement: " & Timer - Début & " secondes."
End Sub

Axe d'amélioration à tester : mémoriser les puissances au fur et à mesure de leur calcul et réutiliser le résultat si le chiffre réapparait, comme c'est la partie sûrement la plus gourmande. A voir...

eric

Bonjour,

Merci pour tes suggestions. Finalement, j'ai opté pour ceci :

Sub Nombres_Narcissiques_2()

Dim Début As Single, n As Long, nc As Long, k As Long, s As Long, i As Long

Dim tab_n()

Début = Timer

Columns("A:A").ClearContents

For n = 0 To 10000000

nc = Len(Trim(n))

For k = 1 To nc

s = s + Mid(n, k, 1) ^ nc

If s > n Then Exit For

Next k

If n = s Then

i = i + 1

ReDim Preserve tab_n(1 To i)

tab_n(i) = n

End If

s = 0

Next n

Range(Cells(1, 1), Cells(i, 1)).Value = Application.Transpose(tab_n)

MsgBox "Durée du traitement: " & Timer - Début & " secondes."

End Sub

75 secondes en passant par un tableau et 77 sans tableau!

Une dernière chose, comment fait-on pour qu'une macro apparaisse entourée de pointillés.

Je vois bien le bouton vert "Code" mais...

Serge

Bonjour,

Oui, le tableau n'apporte pas grand chose ici.

J'ai testé une version qui mémorise les puissances mais 2 fois plus long malgré l'utilisation d'un dictionary. A oublier donc...

comment fait-on pour qu'une macro apparaisse entourée de pointillés.

Sélectionne les lignes avant de cliquer sur code pour la mise en forme.

eric