Reduction du temps de la macro

LeMarchand

XLDnaute Nouveau
Bonjour encore moi ^^

Alors mon problème est que j'ai une macro qui est quasi instantané sur Excel 2003 et qui dure une minute sur Exce2010

Le probleme est sur la ligne :

ActiveSheet.Paste qui dure 24 seconde et j'en ai 2 -3
Je l'ai remplace par:

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

tada je gagne 24 seconde pour chaque lignes

le probleme c'est que ça copie juste les données sa ne garde pas la couleur et les bordures. C'est déja une énorme avancé je trouve mais si qqn a une idée pour coller également les couleur et les bordure

Enfin pour ceux qui s'en fiche j'ai trouvé comment réduire le temps des macro contenant ActiveSheet.Paste

Le probleme est peut être que pour moi enfin si vous pouvez m'aider

Merci

Pour les sources si qqn les demande je les mettraient aucun soucis mais là ce n'est que pour savoir si il y a un autre collé.

Je m'excuse des fautes et de la grammaire de mes phrases

Merci

EDIT:Voir deux posts plus bas c'est mieu expliqué
 
Dernière édition:

Gorfael

XLDnaute Barbatruc
Re : Reduction du temps de la macro

Salut LeMarchand et le forum
Le probleme est sur la ligne :
ActiveSheet.Paste qui dure 24 seconde et j'en ai 2 -3
Je l'ai remplace par:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Comme tu es récent sur le forum, je vais essayer d'être diplomate :D
Un extrait de code ne suffit pas pour dépanner ! Il faut le code en entier, avec son but

Quoique avec ce qu'il y a au-dessus, je puisse déjà dire que tu utilises les Select/Selection qui ne sont, au minimum, qu'une source de perte de temps.

Si tu utilises PasteSpecial avec l'argument xlPasteValues, ne t'étonne pas qu'excel ne copie que les valeurs... puisque c'est ce que tu demandes !

Excel fait toujours (quand c'est possible) ce que tu le demandes de faire et quelques (rares) fois ce que tu veux qu'il fasse
Enfin pour ceux qui s'en fiche j'ai trouvé comment réduire le temps des macro contenant ActiveSheet.Paste
??? :confused: Pourrais-tu expliquer le but de cette phrase ?
- Ceux qui s'en fichent ne vont pas jusqu'à cette ligne
- Personnellement, je me fous complétement que tu ais trouvé comment passer d'un arbre à un tronc... alors que tu laisse le baobab continuer à te ralentir.
Le problème est peut être que pour moi enfin si vous pouvez m'aider
Effectivement, le problème n'est que pour toi... mais la solution peut servir à d'autres, dans d'autres contextes que le tient. C'est pour ça qu'on répond. Et pour un qui pose la question, des dizaines n'osent pas.
Pour les sources si qqn les demande je les mettraient aucun soucis mais là ce n'est que pour savoir si il y a un autre collé.
Je m'excuse des fautes et de la grammaire de mes phrases
Petites remarques anodines :
- Mettre un fichier de travail est rarement une bonne idée. Il vaut mieux faire un fichier qui mette en exergue le problème. Un fichier de test n'st souvent qu'un extrait du fichier qui pose problème, avec une feuille et une dizaine de lignes, suffisant pour comprendre réellement le problème. Par contre, pour pouvoir effectuer un dépannage de macro, ou une amélioration, il faut tout le code, ce qu'il est supposé faire et une idée du contexte.
- On n'est pas à un cours de français, alors les fautes et la grammaire... par contre, il faut que les lecteurs passent moins de temps à déchiffrer la demande qu'à y répondre. Plus le langage est clair et précis, moins on doit l’interpréter et plus la réponse peut correspondre à la demande.
A+
 

LeMarchand

XLDnaute Nouveau
Re : Reduction du temps de la macro

D'accord alors je m'excuse et je réexplique
Voici mon code d'origine je ne mets que une partie car il y a peu de chose qui change dans le reste.

Code:
 Sheets("Données").Activate
    Columns("AA:AA").Select
    Selection.Clear
    
    Sheets("Documentation_essais").Activate
    Columns("D:D").Select
    Selection.Copy    
    Sheets("Données").Activate
    Columns("AA:AA").Select

   ActiveSheet.Paste            '*************** la ligne qui m'interesse

 Selection.Sort Key1:=Range("AA2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal


der = Range("AA1").End(xlDown).Row
    Range("AA1:AA" & der).AdvancedFilter Action:=xlFilterCopy, CopyToRange:= _
        Columns("E:E"), Unique:=True
der = Range("E1").End(xlDown).Row
With NouvelEssai
.Nom.ControlSource = "Données!F1"
.Nom.RowSource = "Données!E2: E" & der
End With

La ligne avec des étoiles avec des compteur ç-à-d des :
date1 = Minute(Time) + Second(Time)
.
.
code
.
.
date2 = Minute(Time) + Second(Time)
rep = MsgBox("1 " & date2 - date1)

Qui m'ont permit de savoir le temps entre ces 2 dates

J'ai pu voir sur quelle partie ma macro prenait le plus de temps et j'ai réduit l'écartement pour arriver a la ligne en rouge qui prenait 24s à elle seul alors qu'elle était quasi instantané sut Excel 2003
C'est alors que j'ai cherché une autre façon de collé et j'ai trouvé avec quelque changement ceci
Code:
 Sheets("Données").Activate
    Columns("AA:AA").Select
    Selection.Clear
    
    Sheets("Documentation_essais").Activate

derD = Range("D1").End(xlDown).Row + 1   '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
   Range("D1:D" & derD).Select   Selection.Copy '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    
    Sheets("Données").Activate

    Range("AA1:AA" & derD).Select  '$$$$$$$$$$$$$$$$$$$$$$

   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False     '$$$$$$$$$$$$$$$$$$$$$$

 Selection.Sort Key1:=Range("AA2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

der = Range("AA1").End(xlDown).Row
    Range("AA1:AA" & der).AdvancedFilter Action:=xlFilterCopy, CopyToRange:= _
        Columns("E:E"), Unique:=True
der = Range("E1").End(xlDown).Row
With NouvelEssai
.Nom.ControlSource = "Données!F1"
.Nom.RowSource = "Données!E2: E" & der
End With
Voilà les changement sont avec des $ ainsi j'ai gagné 23s car il ne lui faut que 1 s pour faire ceci

Voilà ma question : existe t'il une autre façon de coller tout en gardant les couleurs et les bordures?
 

LeMarchand

XLDnaute Nouveau
Re : Reduction du temps de la macro

Bonjour Modeste geedee

Alors je viens de vérifié je n'ai mis que :

Application.ScreenUpdating = False

au début et rien à la fin.

EDIT:Je viens de les mettre sur le fichier d'origine mais cela ne change riensi je laisse comme ça j'ai toujours 52s pour cette macro
 
Dernière édition:

LeMarchand

XLDnaute Nouveau
Re : Reduction du temps de la macro

Je viens de les mettre sur le fichier d'origine mais cela ne change riensi je laisse comme ça j'ai toujours 52s pour cette macro

EDIT: j'ai fait un double post accidentellement
 
Dernière édition:

Si...

XLDnaute Barbatruc
Re : Reduction du temps de la macro

salut tous

Si... tu as des évènementielles essaie (lancement à partir de la feuille "Données") :
Code:
    ...
    Columns(1).Clear
   Application.EnableEvents = False
   With Sheets("Documentation_essais")
     der = .Range("D1").End(xlDown).Row + 1
     .Range("D1:D" & der).Copy Range("AA1")
     Range("AA1:AA" & der).Sort Range("AA2"), 1
     der = Range("AA1").End(xlDown).Row
     Range("AA1:AA" & der).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns(5), Unique:=True
   End With
   Application.EnableEvents = True    'ou plus loin mais indispensable avant de sortir
  ...

Tu peux aussi rajouter les lignes données par Modeste geedee surtout si tu as de nombreuses formules.
 

Misange

XLDnaute Barbatruc
Re : Reduction du temps de la macro

Bonjour

et simplement comme ça puisque si j'ai bien compris tu veux garder les formats

Code:
Sheets("Données").range("A:A").Clearcontents
derD = sheets("Documentation_essais").Range("D1").End(xlDown).Row + 1
Range("D1:D" & derD).Copy destination:= Range("AA1")
 

Misange

XLDnaute Barbatruc
Re : Reduction du temps de la macro

Je te remercie cela marche mais mon but premier est de reduire le temps de la macro et la je retourne a 52 s l'utilisateur va quitter l'application avant d'avoir commencer ^^

Si c'est à moi que tu réponds (c'est pas très clair !) je te dirai : as tu testé d'abord ? Ce code est déjà bien plus simple que le tien et il évite les select et activate inutiles.
Je ne vois cependant rien dans ce code qui justifie qu'il soit plus long sur 2010 que sur 2003.
Avec le classeur ce serait plus facile de tester l'ensemble. Combien as tu de lignes à traiter ?
Sous quel format est-il enregistré : en mode de compatiblité ou en mode 2010 natif ?
 

LeMarchand

XLDnaute Nouveau
Re : Reduction du temps de la macro

Bon alors ce que tu m'as montré je les remplacé à la place de ce que j'avais changer, les $$$$ dans le code , j'ai ,changer le .Past en .special paste c'est quasi tout ce que j'ai fait .
J'ai 340 ligne au max à traiter.
Le format est en .xlsm
Je t'envoie mon fichier quand même mais il est assez dure a comprendre ma macro s'appelle DemandeCreationNouveauNumere
Elle s'active une fois que tu as cliqué sur Retour Formulaire en jaune en haut de la première page
Puis Créer Un nouvel Essai
Merci

Si tu me répond je ne le verrai sans doute que demain

Le mdp est Jenny
 

Pièces jointes

  • Essais_industriels_V2.xlsm
    287 KB · Affichages: 87
Dernière édition:

Misange

XLDnaute Barbatruc
Re : Reduction du temps de la macro

Ce que Si... et moi même nous t'avons proposé c'est un code condensé qui évite tous ces select qui sont une source considérable de ralentissement. Je n'ai certes pas le temps de reprendre tout ton code ligne à ligne mais il faut que tu le fasses pour l'optimiser car il n'y a aucune raison que cela soit long. J'ai un PC assez musclé et de fait j'ai un temps inacceptable compte tenu de l'absence de calculs quand on demande simplement la création d'une nouvelle fiche.

J'ai jeté rapidement un oeil sur ton code et je lis des activate et des select toutes les deux lignes !
genre
Sheets("Documentation_essais").Activate
Columns("E:E").Select
Selection.Copy
Sheets("Données").Activate
Columns("AA:AA").Select
ActiveSheet.Paste

Reprends le code que tu as posté et celui que Si... ou moi nous t'avons proposé.
les lignes du dessus s'écrivent tout simplement
Sheets("documentation-essais").columns(5).copy destination:= sheets("Données").range("AA1")
Ce n'est pas seulement plus compact à l'écriture, c'est surtout qu'on évite de balader excel d'une feuille à l'autre.

Ce n'est pas juste à l'endroit que tu crois avoir identifié comme étant responsable de la lenteur que le problème se produit. C'est l'ensemble de ton code qui doit être optimisé. Tu as déjà fait un très gros boulot, il serait dommage de s'arrêter en cours de route.
Un des problèmes majeurs de l'enregistreur de code c'est qu'il met justement des activate et des select partout, ce qui est pratique pour comprendre ce qu'il a fait mais qui n'est vraiment pas le moyen optimisé d'écrire une macro.

Reprends ton code et recherche tous les select. dans 99% des cas sinon 99.999, il est non seulement inutile mais néfaste de les mettre.

Courage :)
 

Si...

XLDnaute Barbatruc
Re : Reduction du temps de la macro

re

Si... je ne peux qu'approuver les remarques judicieuses de Misange, j'ai constaté qu'en supprimant ton onglet Données (qui contient des images :confused:) et créant une nouvelle feuille avec ce nom, je n'avais plus ces moments interminables d'attente.
Voilà un exemple de simplification :
Supprime ta macro Sub auto_open() et dans ThisWorkbook copie
Code:
Private Sub Workbook_Open()
  If Application.ReferenceStyle = xlR1C1 Then Application.ReferenceStyle = xlA1
  Sheets("Documentation_essais").Activate
  Application.ScreenUpdating = False
  Me.Unprotect Password:="Jenny"
  Columns("A:W").Sort Range("W2"), 1
  Me.Protect Password:="Jenny", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowSorting:=True, AllowFiltering:=True

  With Sheets("Données")
    .Cells.Clear
   .Range("CA1") = "OUVERTURE"
  End With

  DAT = "30/04/2011"

  If Date >= DAT Then
    MsgBox "Vous allez utiliser une nouvelle version du fichier." & Chr(10) & _
      "Le fichier de base est toujours le même." & Chr(10) & _
      "Seule une colonne N° de LUP a été ajoutée" & Chr(10) & _
      "Toutes vos remarques sont à comminiquer à:" & Chr(10) & _
      "     Jenny Lemée Tel: 21862.", 16, "Information fichier"
  End If
  Application.OnTime Now + TimeValue("01:00:00"), "fin"
  Accueil.Show
End Sub
 

LeMarchand

XLDnaute Nouveau
Re : Reduction du temps de la macro

Excuse moi de répondre si tardivement j'étais malade donc j'ai essayé ton code :
j'ai du changer le

Me.Unprotect Password:="Jenny"
en
Sheets("Documentation_essais").Unprotect Password:="Jenny"

Pour tout dire il ne reconnait pas ton Me
As tu pour cela une macro complémentaire ? ma version n'est pas à jour ? Où as tu déclaré une variable ?
 

Discussions similaires

Statistiques des forums

Discussions
312 502
Messages
2 089 040
Membres
104 010
dernier inscrit
Freba