Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Execution Macro très lente

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

arckeo72

XLDnaute Nouveau
Bonjour à tous,

J’exécute la macro suivante et je trouve l’application plutôt lente.

Comme je ne sais pas comment la simplifier je fais appel à vous.

"Sub Macro1()
'
' Macro1 Macro
'

'
ActiveSheet.Range("$A$2:$S$65536").AutoFilter Field:=7, Criteria1:=Range("J1")
Rows("6:6").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A6").Select
ActiveCell.FormulaR1C1 = "=R[1]C"
Range("B6").Select
ActiveCell.FormulaR1C1 = "=R[1]C+1"
Range("C6").Select
ActiveCell.FormulaR1C1 = "=R[1]C"
Range("D6").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("F7").Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Range("H7").Select
Selection.Copy
Range("H6").Select
ActiveSheet.Paste
Range("J7").Select
Selection.Copy
Range("J6").Select
ActiveSheet.Paste
Range("J1").Select
Selection.Copy
Range("G6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub"


A noter l'execution de ma macro se fait via celle-ci :

"Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$J$1" Then Call Macro1
End Sub"

D'avance merci.
 
Re : Execution Macro très lente

Bonjour arckeo72
Au plus simple, il est inutile d'utiliser tous ces vilains Select 😀
VB:
Sub Macro2()
Application.ScreenUpdating = False 'bloquer l'affichage écran
ActiveSheet.Range("$A$2:$S$65536").AutoFilter Field:=7, Criteria1:=Range("J1")
Rows("6:6").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A6").FormulaR1C1 = "=R[1]C"
Range("B6").FormulaR1C1 = "=R[1]C+1"
Range("C6").FormulaR1C1 = "=R[1]C"
Range("D6").FormulaR1C1 = "=TODAY()"
Range("F7").Copy Range("F6")
Range("H7").Copy Range("H6")
Range("J7").Copy Range("J6")
Range("G6").Value = Range("J1").Value
End Sub

Cordialement
 
Re : Execution Macro très lente

Merci beaucoup ça marche nickel.

J'ai également rajouter ceci pour améliorer la vitesse d'exécution :
Au début de la macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Avant la fin de la macro
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


Salutations.
 
Bonjour,

Je m'incruste dans la conversation car j'ai fait une macro qui fonctionne bien mais qui est lente...comment puis l'optimiser en sachant que j'ai utilisé la méthode d'arckeo72. Merciiiii

Code:
Sub Macro1()
'
' Macro1 Macro
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'
Application.Dialogs.Item(xlDialogOpen).Show
           Range("A1:AH" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    ActiveWindow.Close
    Windows("Cotisations macro.xlsm").Activate
    Range("A1").Select
    ActiveSheet.Paste
   


    Range("AI1").Select
    ActiveCell.FormulaR1C1 = "Doublons"

'Recherche de doublon dans les contrats
    Range("AI2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R2C15:RC[-20],RC[-20])=1,SUMIF(C[-20],RC[-20],C[-4]),"""")"

'Tirer la formule vers le bas
Dim LastRw As Long
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("AI2:AI" & LastRw).FillDown


'Analyse les doublons
    Range("AJ1").Select
    ActiveCell.FormulaR1C1 = "Analyse doublons"
    Range("AJ2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=1,""Pas de doublon"",""Doublon"")"
    Range("AJ2").Select

'Tirer la formule vers le bas
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("AJ2:AJ" & LastRw).FillDown

'Masque la cellule
Columns("AI:AI").Select
Selection.EntireColumn.Hidden = True
   
'Recherche des tarifs chelou
Range("AK1").Select
ActiveCell.FormulaR1C1 = "Analyse tarif"
Range("AK2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-17],Tarif!R1C1:R152C2,2,FALSE),""Tarif à contrôler"")"

'Tirer la formule vers le bas
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("AK2:AK" & LastRw).FillDown


'Colonne pour resumer les contrôles
Range("AL1").Select
ActiveCell.FormulaR1C1 = "Contrôles"
Range("AL2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(RC[-2]=""Doublon"",RC[-1]=""Tarif à contrôler""),""Contrôle à faire"",""Pas de contrôle"")"

'Tirer la formule vers le bas
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("AL2:AL" & LastRw).FillDown

'copier coller valeurs pour enlever les formules
Columns("AJ:AL").Select
Range("AL1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub
 
Bonjour

Crées un nouveau fil et mets un fichier exemple pour les tests
en attendant tu devrais gagner un peu de temps sur ton collage de valeurs
Code:
'copier coller valeurs pour enlever les formules
Range("AJ1:AL" & Range("AJ65536").End(xlUp).Row).Value = Range("AJ1:AL" & Range("AJ65536").End(xlUp).Row).Value
 
Bonjour oz2007, Bonjour Yeahou, le fil, le forum
Comme je disais en 2013 (Déjà 4 ans, que le temps passe....):
il est inutile d'utiliser tous ces vilains Select 😀
En 2017 je rajoute
Traiter les colonnes au fur et à mesure et éviter les FillDown:
(J'ai mis en commentaire la partie que je ne peux tester)
VB:
Sub Macro1()
Dim LastRw As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Application.Dialogs.Item(xlDialogOpen).Show
            'Range("A1:AH" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select
     'Selection.Copy
     'ActiveWindow.Close
     'Windows("Cotisations macro.xlsm").Activate
     'Range("A1").Select
     'ActiveSheet.Paste

Range("AI1") = "Doublons"
Range("AJ1") = "Analyse doublons"
Range("AK1") = "Analyse tarif"
Range("AL1") = "Contrôles"
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row

'Recherche de doublon dans les contrats
With Range("AI2:AI" & LastRw)
    .FormulaR1C1 = "=IF(COUNTIF(R2C15:RC[-20],RC[-20])=1,SUMIF(C[-20],RC[-20],C[-4]),"""")"
    .Value = .Value
End With
'Analyse les doublons
With Range("AJ2:AJ" & LastRw)
    .FormulaR1C1 = "=IF(RC[-1]=1,""Pas de doublon"",""Doublon"")"
    .Value = .Value
    'Masque la cellule
    .EntireColumn.Hidden = True
End With
'Recherche des tarifs chelou
With Range("AK2:AK" & LastRw)
    .FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-17],Tarif!R1C1:R152C2,2,FALSE),""Tarif à contrôler"")"
    .Value = .Value
End With
'Colonne pour resumer les contrôles
With Range("AL2:AL" & LastRw)
    .FormulaR1C1 = _
        "=IF(OR(RC[-2]=""Doublon"",RC[-1]=""Tarif à contrôler""),""Contrôle à faire"",""Pas de contrôle"")"
    .Value = .Value
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Cordialement
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
18
Affichages
211
Réponses
10
Affichages
467
Réponses
7
Affichages
84
Réponses
17
Affichages
900
Réponses
1
Affichages
473
Réponses
1
Affichages
384
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…