Discussion :

[pierreleroy]

Bonjour à tous,

Je me permets de laisser un petit message car le code que je réalise rame tellement qu'il met 45min avant de finir (si il fini) si bien que la tâche que la macro effectue serait plus rapide à la mains.
But de la macro :
La macro suivante à pour but de répliquer la ligne 9 à 14, sur n itération (demandé à l'utilisateur).

Initialement, l'idée pour gagner du temps était de copier 1 fois puis 2 puis 4 puis 8 (2^n) etc... mais évidemment arrivé à copier 1000 lignes, Excel sature et plante.
J'ai donc découper en deux parties : l'une pour augmenter le nombre de ligne copié d'un coup (2^4) puis de manière constante (2^4 mais j fois).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
Sub PropagerModificationDeLignes9a14()
'
' PropagerModificationDeLignes9a14 Macro
' Permet de propager les formules de calcules de la lignes 10 à 14 jusquà 12 000 itération
'
Worksheets("Bilan Dynamique").Activate
Rows("15:15").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Clear
Application.Calculation = xlManual
 
itMax = InputBox("Nombre d'itération maximum souhaité", "Choix du nombre d'itération", "100")
If (itMax <> 0) Then
iMax = 4
jMax = itMax / (2 ^ (iMax + 1))
jMax = Round(jMax + 0.5)
 
For i = 0 To iMax - 1
    Rows("9:" & (6 * 2 ^ i + 8)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Rows((6 * 2 ^ i + 9) & ":" & (6 * 2 ^ (i + 1) + 9)).Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    'Application.Wait Time + TimeSerial(0, 0, 1)
Next
Rows("9:" & (6 * 2 ^ i + 8)).Select
Application.CutCopyMode = False
Selection.Copy
For j = 0 To jMax - 1
Rows((6 * 2 ^ (i) * j + 9 & ":" & 6 * 2 ^ (i) * (2 * j + 1) + 8)).Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
'Application.Wait Time + TimeSerial(0, 0, 1)
Next
Application.Calculation = xlAutomatic
 
End If
'
End Sub

Initialement, le copier coller de ces lignes fonctionnes très bien mais cela met de plus en plus de temps à chaque copier coller.
Le Code fonctionne péniblement jusqu'à 2000 itération (ligne 12008) puis erreur 1004. Je pense que cela vient de la fonction "coller" qui sature en mémoire (pourtant le nombre de ligne copier reste constant).

Si jamais vous avez une idée de comment permettre à ce code d'aller plus vite, je suis preneur !

Pierre

[Marc-L]

Bonjour,

déjà ne pas utiliser Paste mais uniquement la méthode Copy en indiquant l'argument Destination
comme pourtant indiqué dans l'aide VBA interne …

_________________________________________________________________________________________________________

Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

[pierreleroy]

Re,

Merci pour la réponse rapide ! =D

Ce bout de code de "Paste" a été généré par Excel lui-même en enregistrant la macro en premier lieu. Je n'ai ensuite que remplacé les Ranges de manière à avoir une boucle.
Je suppose que cela permet de ne pas passer par le presse-papier ?

J'ai donc testé rapidement en changeant par exemple par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
 Rows("9:" & (6 * 2 ^ i + 8)).Copy _
        Destination:=Rows((6 * 2 ^ i + 9) & ":" & (6 * 2 ^ (i + 1) + 9))

Je sens une nette amélioration mais toujours un ralentissement au fur et à mesure de la progression.
Pourtant, j'ai bien désactivé la mise à jours des calculs donc il ne devrait pas recalculer à chaque fois et pourtant :


Le programme s'arrête toujours au environ du l'itération 1744 (ligne 10 472) pour ce test avec l'erreur 1004. (Même après un copier/coller de 12 lignes manuel, la session Excel plante)

Cordialement,
Pierre,

P.S: Je vire les .select et .selection qui me permettais de vérifier mon code

[Marc-L]

L'avantage de Copy direct est la possibilité d'indiquer seulement la première cellule de destination.

Sinon pour récupérer uniquement les valeurs un exemple dans cette discussion
mais là par contre la taille des plages source et destination doivent correspondre …

[pierreleroy]

D'accord, cela m'éviterais de me balader avec la taille de ma sélection à chaque fois... Je vais essayer.
J'ai donc essayé et j'ai encore une augmentation de la vitesse de calcul ! Le calcul à chaque fois de 6*2^i+9 il ne doit pas aimer. Je vais donc essayer de changer mes indices pour virer le ^i (qui est sans doute la tâche la plus difficile).
Je vais sans doute passer avec un i=i+6

Par contre, je reste bien dans le même Excel, dans la même feuille Excel et ce sont les formules qui m’intéresse pas les valeurs. Les formules dans les cellules sont en relatif du coup elles sont répercutées les une en dessous des autres.

Petite image pour aider à comprendre

[pierreleroy]

Re,

code updated pour ceux qui retomberais sur ce post :

J'ai réussi à passer 1000 itération en 107s en utilisant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Application.ScreenUpdating = False

Voici le code entier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
Sub PropagerModificationDeLignes9a14()
'
' PropagerModificationDeLignes9a14 Macro
' Permet de propager les formules de calcules de la lignes 10 à 14 jusquà 12 000 itération
'
Worksheets("Bilan Dynamique").Activate
Range(Rows("15:15"), Rows("15:15").End(xlDown)).Clear
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.CutCopyMode = False
 
itMax = InputBox("Nombre d'itération maximum souhaité", "Choix du nombre d'itération", "100")
If (itMax <> 0) Then
iMax = 5
jMax = itMax / (2 ^ (iMax))
jMax = Round(jMax)
 
startTime = Time
 
For i = 0 To iMax - 1
    Rows("9:" & (6 * 2 ^ i + 8)).Copy _
        Destination:=Range("A" & (6 * 2 ^ i + 9))
    'Application.Wait Time + TimeSerial(0, 0, 1)
Next
 
For j = 0 To jMax - 1
Rows("9:" & (6 * 2 ^ (i) + 8)).Copy _
    Destination:=Range("A" & 6 * 2 ^ (i) * (j + 1) + 9)
    'Application.Wait Time + TimeSerial(0, 0, 3)
Next
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
 
stopTime = Time
elapsedTime = (stopTime - startTime) * 24 * 60 * 60
MsgBox "Temps passé à la propagation : " & elapsedTime
 
Range("A" & 6 * 2 ^ (i) * (j + 1) + 9) = "iMax =" & iMax & " jMax=" & jMax
Range("A" & 6 * 2 ^ (i) * (j + 1) + 10) = "i =" & i & " j=" & j
 
End If
'
End Sub

Testons pour 15 000 itération ...
Rire diabolique : MOUHAHAHAHHAHAHA

Pierre,