Discussion :

[a_centaure]

Bonjour,

j'ai le code suivant :

Code :

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

1
2
3
4
5
6
7
 
Sheets("temp").Select
    Range(Columns(5), Columns(4 + Nbr_Ech)).Select
    Selection.Copy
    Sheets("Final").Select
    Range(Columns(5), Columns(4 + Nbr_Ech)).Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

je voudrais tenter d’accélérer cette partie en l'optimisant car ces plages peuvent contenir 100 colonnes et 10000 lignes. Et donc cette copie prend du temps
Je cherche quelque chose du genre
[A1].copy [A2]
mais uniquement pour les formats.
Eventuellement en decoupant en boucle (meme si je n'ai pas l'impression que les boucles viennent à accelerer la copie)


Avez vous une idée?

merci

[Stef999]

Bonjour,

il faut désactiver la mise à jour de l'affichage ...
La copie peut se faire via une boucle ... et par plage de cellules evidemment

Code :

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

1
2
3
4
5
6
7
Application.ScreenUpdating = False
 
 
Sheets("temp").Range(Columns(5), Columns(4 + Nbr_Ech)).Copy
Sheets("Final").Range(Columns(5), Columns(4 + Nbr_Ech)).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Application.ScreenUpdating = True

[a_centaure]

la desactivation de l'affichage est deja fait (plus haut dans mon script, je ne l'ai pas reporté ici, desolé)

- le fait de ne pas passer par des "select" accelere t-il le traitement?
- vous parlez de boucle. Y a t-il un gain de faire un traitement, par exemple, colonne par colonne, plutot que la plage complete d'un coup?

[Stef999]

Je voulais répondre intuitivement que d'utiliser au maximum les fonctions natives d'Excel, une plage plutot qu'un boucle sur cellule, devrait être plus efficace car le code de l'application est plus efficace que le code VBA ...

Pour vérifier :

J'ai fais formaté d'une couleur de remplissage aleatoire une plage de 100 col par 5000 lignes, cette plage contient également des valeurs numériques.

J'ai tenté différentes manières de faires des copier/collerformat ... les résultats sont bien pires que je ne pensais !!! D'ailleurs cela fait je ne sais combien de temps que j'attends pour le résultat du dernier test .... j'attends ... j'attends ...

Sur les 3 premiers essais les temps sont variables ... normal ils sont faibles et l'ordinateur fait autre chose qu'Excel ...

sans ScreenUpdating = False

Code :

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

1
2
3
4
5
6
7
8
9
Sub CopieFormat1()
 
temps = Timer
Sheets("Feuil1").Range("A1:CV5000").Copy
Sheets("Feuil2").Range("A1:CV5000").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
MsgBox Timer - temps
' 0.296 à 0.3125 secondes
End Sub

avec ScreenUpdating = False

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub CopieFormat2()
 
Application.ScreenUpdating = False
temps = Timer
 
Sheets("Feuil1").Range("A1:CV5000").Copy
Sheets("Feuil2").Range("A1:CV5000").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Application.ScreenUpdating = True
 
MsgBox Timer - temps
'0.325 à 0.328 secondes
End Sub

avec activate et select

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
Sub CopieFormat3()
 
Application.ScreenUpdating = False
temps = Timer
Sheets("Feuil1").Activate
Sheets("Feuil1").Range("A1:CV5000").Select
Selection.Copy
Sheets("Feuil2").Activate
Sheets("Feuil2").Range("A1:CV5000").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Application.ScreenUpdating = True
 
MsgBox Timer - temps
' 0.325 secondes à 0.343 secondes
End Sub

Et par une boucle .... pfff .... pffff

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
Sub CopieFormat4()
 
Application.ScreenUpdating = False
temps = Timer
 
For x = 1 To 100
    For y = 1 To 5000
Sheets("Feuil1").Cells(y, x).Copy
Sheets("Feuil2").Cells(y, x).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next y
Next x
 
Application.ScreenUpdating = True
 
MsgBox Timer - temps
' 1702 secondes !!!!!!!
End Sub

[a_centaure]

ok,

par contre, je suis surpris, c'est le script avec le rafraichissement d'ecran actif (Application.ScreenUpdating) qui est le plus rapide !!

mais effectivement, des fois c'est long, c'est long !!

bon j'ai essayé la 1ere methode,

Code :

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

1
2
    Sheets("temp").Range(Cells(1, 5), Cells(Derniere_Ligne_Col_N(1), 4 + Nbr_Ech)).Copy
    Sheets("final").Range(Cells(1, 5), Cells(Derniere_Ligne_Col_N(1), 4 + Nbr_Ech)).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

mais ca me jete :

Erreur définie par l'application ou par l'objet

[Stef999]

Bonjour,

Vérifiez que la zone de collage est valide (fusion, protection, validation etc ...)

Vérifiez les valeurs de Derniere_Ligne_Col_N(1) et Nbr_Ech

Si tout est bon de ce coté, essayez de mettre une gestion d'erreur pour avoir plus d'info sur l'erreur.