Rendre une macro plus rapide

Résolu/Fermé
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020 - 23 août 2015 à 23:41
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020 - 24 août 2015 à 14:25
Bonjour,

Je dispose de la macro suivante, simplement son éxecution prend un temps infini...

Sub EffaceEtFiltreBLOCS()
Dim Plage As Range
Application.ScreenUpdating = False
'neutralise le recalcule
Application.Calculation = xlCalculationManual
With Sheets("BLOCS")
' regroupement de tes deux plages dans une seule
Set Plage = Union(.Range(.Cells(6, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 10)), .Range(.Cells(7, 11), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 44)))

'effacement des deux plage
Plage.ClearContents
End With
'remise en place du recalcule automatique
Application.Calculation = xlCalculationAutomatic

' partie liée au filtre avancé
With Sheets("Base SID")
Set Plage = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row, 9))
Plage.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("BLOCS").[B1:B2], CopyToRange:=Sheets("BLOCS").[B6], Unique:=False
End With
'Mise en forme
With Sheets("BLOCS")
.Select
Range("B6:J6").Font.Bold = True
Range("B6:J6").Font.Size = 16
Range("B6:J6").Font.ColorIndex = 2
Range("B6:J6").Interior.ColorIndex = 41
Range("B6:J6").HorizontalAlignment = xlCenter
Range(.Cells(7, 6), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 10)).HorizontalAlignment = xlCenter
Range(.Cells(7, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 5)).HorizontalAlignment = xlLeft
Range(.Cells(7, 11), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 41)).HorizontalAlignment = xlCenter
Range(.Cells(7, 15), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 17)).NumberFormat = "#0"
Range(.Cells(7, 18), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 19)).NumberFormat = "#0.00"
Range(.Cells(7, 22), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 25)).NumberFormat = "#0.00"
Range(.Cells(7, 26), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 26)).NumberFormat = "#0.0, %"
Range(.Cells(7, 27), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 29)).NumberFormat = "#0.00"
Range(.Cells(7, 30), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 30)).NumberFormat = "#0.0, %"
Range(.Cells(7, 31), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 34)).NumberFormat = "#0.00"
Range(.Cells(7, 35), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 35)).NumberFormat = "#0.0, %"
Range(.Cells(7, 36), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 38)).NumberFormat = "#0.00"
Range(.Cells(7, 39), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 39)).NumberFormat = "#0.0, %"
Range(.Cells(7, 40), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 42)).NumberFormat = "#0.00"
Range(.Cells(7, 43), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 43)).NumberFormat = "#0.0, %"


'Calcul des formules pour les colonnes de K à AQ

Set PlageK = .Range(.Cells(7, 11), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 11))
PlageK.FormulaR1C1 = .Cells(2, 11).FormulaR1C1
Set PlageL = .Range(.Cells(7, 12), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 12))
PlageL.FormulaR1C1 = .Cells(2, 12).FormulaR1C1
Set PlageM = .Range(.Cells(7, 13), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 13))
PlageM.FormulaR1C1 = .Cells(2, 13).FormulaR1C1
Set PlageN = .Range(.Cells(7, 14), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 14))
PlageN.FormulaR1C1 = .Cells(2, 14).FormulaR1C1
Set PlageO = .Range(.Cells(7, 15), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 15))
PlageO.FormulaR1C1 = .Cells(2, 15).FormulaR1C1
Set PlageP = .Range(.Cells(7, 16), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 16))
PlageP.FormulaR1C1 = .Cells(2, 16).FormulaR1C1
Set PlageQ = .Range(.Cells(7, 17), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 17))
PlageQ.FormulaR1C1 = .Cells(2, 17).FormulaR1C1
Set PlageR = .Range(.Cells(7, 18), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 18))
PlageR.FormulaR1C1 = .Cells(2, 18).FormulaR1C1
Set PlageS = .Range(.Cells(7, 19), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 19))
PlageS.FormulaR1C1 = .Cells(2, 19).FormulaR1C1
Set PlageT = .Range(.Cells(7, 20), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 20))
PlageT.FormulaR1C1 = .Cells(2, 20).FormulaR1C1
Set PlageU = .Range(.Cells(7, 21), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 21))
PlageU.FormulaR1C1 = .Cells(2, 21).FormulaR1C1
Set PlageV = .Range(.Cells(7, 22), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 22))
PlageV.FormulaR1C1 = .Cells(2, 22).FormulaR1C1
Set PlageW = .Range(.Cells(7, 23), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 23))
PlageW.FormulaR1C1 = .Cells(2, 23).FormulaR1C1
Set PlageX = .Range(.Cells(7, 24), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 24))
PlageX.FormulaR1C1 = .Cells(2, 24).FormulaR1C1
Set PlageY = .Range(.Cells(7, 25), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 25))
PlageY.FormulaR1C1 = .Cells(2, 25).FormulaR1C1
Set PlageZ = .Range(.Cells(7, 26), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 26))
PlageZ.FormulaR1C1 = .Cells(2, 26).FormulaR1C1
Set PlageAA = .Range(.Cells(7, 27), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 27))
PlageAA.FormulaR1C1 = .Cells(2, 27).FormulaR1C1
Set PlageAB = .Range(.Cells(7, 28), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 28))
PlageAB.FormulaR1C1 = .Cells(2, 28).FormulaR1C1
Set PlageAC = .Range(.Cells(7, 29), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 29))
PlageAC.FormulaR1C1 = .Cells(2, 29).FormulaR1C1
Set PlageAD = .Range(.Cells(7, 30), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 30))
PlageAD.FormulaR1C1 = .Cells(2, 30).FormulaR1C1
Set PlageAE = .Range(.Cells(7, 31), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 31))
PlageAE.FormulaR1C1 = .Cells(2, 31).FormulaR1C1
Set PlageAF = .Range(.Cells(7, 32), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 32))
PlageAF.FormulaR1C1 = .Cells(2, 32).FormulaR1C1
Set PlageAG = .Range(.Cells(7, 33), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 33))
PlageAG.FormulaR1C1 = .Cells(2, 33).FormulaR1C1
Set PlageAH = .Range(.Cells(7, 34), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 34))
PlageAH.FormulaR1C1 = .Cells(2, 34).FormulaR1C1
Set PlageAI = .Range(.Cells(7, 35), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 35))
PlageAI.FormulaR1C1 = .Cells(2, 35).FormulaR1C1
Set PlageAJ = .Range(.Cells(7, 36), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 36))
PlageAJ.FormulaR1C1 = .Cells(2, 36).FormulaR1C1
Set PlageAK = .Range(.Cells(7, 37), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 37))
PlageAK.FormulaR1C1 = .Cells(2, 37).FormulaR1C1
Set PlageAL = .Range(.Cells(7, 38), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 38))
PlageAL.FormulaR1C1 = .Cells(2, 38).FormulaR1C1
Set PlageAM = .Range(.Cells(7, 39), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 39))
PlageAM.FormulaR1C1 = .Cells(2, 39).FormulaR1C1
Set PlageAN = .Range(.Cells(7, 40), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 40))
PlageAN.FormulaR1C1 = .Cells(2, 40).FormulaR1C1
Set PlageAO = .Range(.Cells(7, 41), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 41))
PlageAO.FormulaR1C1 = .Cells(2, 41).FormulaR1C1
Set PlageAP = .Range(.Cells(7, 42), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 42))
PlageAP.FormulaR1C1 = .Cells(2, 42).FormulaR1C1
Set PlageAQ = .Range(.Cells(7, 43), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 43))
PlageAQ.FormulaR1C1 = .Cells(2, 43).FormulaR1C1
Set PlageAR = .Range(.Cells(7, 44), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 44))
PlageAR.FormulaR1C1 = .Cells(2, 44).FormulaR1C1
End With

End Sub



Quelqu'un aurait une astuce pour la rendre plus rapide ?

Merci beaucoup
A voir également:

1 réponse

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
24 août 2015 à 10:53
Bonjour,

pour commencer:

Sub EffaceEtFiltreBLOCS()
Dim Plage As Range
Application.ScreenUpdating = False
'neutralise le recalcule
Application.Calculation = xlCalculationManual
With Sheets("BLOCS")
    ' regroupement de tes deux plages dans une seule
    Set Plage = Union(.Range(.Cells(6, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 10)), .Range(.Cells(7, 11), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 44)))    'effacement des deux plage
    Plage.ClearContents
End With
'remise en place du recalcule automatique
Application.Calculation = xlCalculationAutomatic
 
' partie liée au filtre avancé
With Sheets("Base SID")
    Set Plage = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row, 9))
    Plage.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("BLOCS").[B1:B2], CopyToRange:=Sheets("BLOCS").[B6], Unique:=False
End With
 'Mise en forme
With Sheets("BLOCS")
    .Select
    Range("B6:J6").Font.Bold = True
    Range("B6:J6").Font.Size = 16
    Range("B6:J6").Font.ColorIndex = 2
    Range("B6:J6").Interior.ColorIndex = 41
    Range("B6:J6").HorizontalAlignment = xlCenter
    'derniere cellule non vide colonne B
    derlig = .Cells(.Rows.Count, 2).End(xlUp).Row
    Application.Calculation = xlCalculationManual
    Range(.Cells(7, 6), .Cells(derlig, 10)).HorizontalAlignment = xlCenter
    Range(.Cells(7, 2), .Cells(derlig, 5)).HorizontalAlignment = xlLeft
    Range(.Cells(7, 11), .Cells(derlig, 41)).HorizontalAlignment = xlCenter
    Range(.Cells(7, 15), .Cells(derlig, 17)).NumberFormat = "#0"
    Range(.Cells(7, 18), .Cells(derlig, 19)).NumberFormat = "#0.00"
    Range(.Cells(7, 22), .Cells(derlig, 25)).NumberFormat = "#0.00"
    Range(.Cells(7, 26), .Cells(derlig, 26)).NumberFormat = "#0.0, %"
    Range(.Cells(7, 27), .Cells(derlig, 29)).NumberFormat = "#0.00"
    Range(.Cells(7, 30), .Cells(derlig, 30)).NumberFormat = "#0.0, %"
    Range(.Cells(7, 31), .Cells(derlig, 34)).NumberFormat = "#0.00"
    Range(.Cells(7, 35), .Cells(derlig, 35)).NumberFormat = "#0.0, %"
    Range(.Cells(7, 36), .Cells(derlig, 38)).NumberFormat = "#0.00"
    Range(.Cells(7, 39), .Cells(derlig, 39)).NumberFormat = "#0.0, %"
    Range(.Cells(7, 40), .Cells(derlig, 42)).NumberFormat = "#0.00"
    Range(.Cells(7, 43), .Cells(derlig, 43)).NumberFormat = "#0.0, %"

    'Calcul des formules pour les colonnes de K à AQ
   Set PlageK = .Range(.Cells(7, 11), .Cells(derlig, 11))
    PlageK.FormulaR1C1 = .Cells(2, 11).FormulaR1C1
   Set PlageL = .Range(.Cells(7, 12), .Cells(derlig, 12))
    PlageL.FormulaR1C1 = .Cells(2, 12).FormulaR1C1
   Set PlageM = .Range(.Cells(7, 13), .Cells(derlig, 13))
    PlageM.FormulaR1C1 = .Cells(2, 13).FormulaR1C1
   Set PlageN = .Range(.Cells(7, 14), .Cells(derlig, 14))
    PlageN.FormulaR1C1 = .Cells(2, 14).FormulaR1C1
   Set PlageO = .Range(.Cells(7, 15), .Cells(derlig, 15))
    PlageO.FormulaR1C1 = .Cells(2, 15).FormulaR1C1
   Set PlageP = .Range(.Cells(7, 16), .Cells(derlig, 16))
    PlageP.FormulaR1C1 = .Cells(2, 16).FormulaR1C1
   Set PlageQ = .Range(.Cells(7, 17), .Cells(derlig, 17))
    PlageQ.FormulaR1C1 = .Cells(2, 17).FormulaR1C1
   Set PlageR = .Range(.Cells(7, 18), .Cells(derlig, 18))
    PlageR.FormulaR1C1 = .Cells(2, 18).FormulaR1C1
   Set PlageS = .Range(.Cells(7, 19), .Cells(derlig, 19))
    PlageS.FormulaR1C1 = .Cells(2, 19).FormulaR1C1
   Set PlageT = .Range(.Cells(7, 20), .Cells(derlig, 20))
    PlageT.FormulaR1C1 = .Cells(2, 20).FormulaR1C1
   Set PlageU = .Range(.Cells(7, 21), .Cells(derlig, 21))
    PlageU.FormulaR1C1 = .Cells(2, 21).FormulaR1C1
   Set PlageV = .Range(.Cells(7, 22), .Cells(derlig, 22))
    PlageV.FormulaR1C1 = .Cells(2, 22).FormulaR1C1
   Set PlageW = .Range(.Cells(7, 23), .Cells(derlig, 23))
    PlageW.FormulaR1C1 = .Cells(2, 23).FormulaR1C1
   Set PlageX = .Range(.Cells(7, 24), .Cells(derlig, 24))
    PlageX.FormulaR1C1 = .Cells(2, 24).FormulaR1C1
   Set PlageY = .Range(.Cells(7, 25), .Cells(derlig, 25))
    PlageY.FormulaR1C1 = .Cells(2, 25).FormulaR1C1
   Set PlageZ = .Range(.Cells(7, 26), .Cells(derlig, 26))
    PlageZ.FormulaR1C1 = .Cells(2, 26).FormulaR1C1
   Set PlageAA = .Range(.Cells(7, 27), .Cells(derlig, 27))
    PlageAA.FormulaR1C1 = .Cells(2, 27).FormulaR1C1
   Set PlageAB = .Range(.Cells(7, 28), .Cells(derlig, 28))
    PlageAB.FormulaR1C1 = .Cells(2, 28).FormulaR1C1
   Set PlageAC = .Range(.Cells(7, 29), .Cells(derlig, 29))
    PlageAC.FormulaR1C1 = .Cells(2, 29).FormulaR1C1
   Set PlageAD = .Range(.Cells(7, 30), .Cells(derlig, 30))
    PlageAD.FormulaR1C1 = .Cells(2, 30).FormulaR1C1
   Set PlageAE = .Range(.Cells(7, 31), .Cells(derlig, 31))
    PlageAE.FormulaR1C1 = .Cells(2, 31).FormulaR1C1
   Set PlageAF = .Range(.Cells(7, 32), .Cells(derlig, 32))
    PlageAF.FormulaR1C1 = .Cells(2, 32).FormulaR1C1
   Set PlageAG = .Range(.Cells(7, 33), .Cells(derlig, 33))
    PlageAG.FormulaR1C1 = .Cells(2, 33).FormulaR1C1
   Set PlageAH = .Range(.Cells(7, 34), .Cells(derlig, 34))
    PlageAH.FormulaR1C1 = .Cells(2, 34).FormulaR1C1
   Set PlageAI = .Range(.Cells(7, 35), .Cells(derlig, 35))
    PlageAI.FormulaR1C1 = .Cells(2, 35).FormulaR1C1
   Set PlageAJ = .Range(.Cells(7, 36), .Cells(derlig, 36))
    PlageAJ.FormulaR1C1 = .Cells(2, 36).FormulaR1C1
   Set PlageAK = .Range(.Cells(7, 37), .Cells(derlig, 37))
    PlageAK.FormulaR1C1 = .Cells(2, 37).FormulaR1C1
   Set PlageAL = .Range(.Cells(7, 38), .Cells(derlig, 38))
    PlageAL.FormulaR1C1 = .Cells(2, 38).FormulaR1C1
   Set PlageAM = .Range(.Cells(7, 39), .Cells(derlig, 39))
    PlageAM.FormulaR1C1 = .Cells(2, 39).FormulaR1C1
   Set PlageAN = .Range(.Cells(7, 40), .Cells(derlig, 40))
    PlageAN.FormulaR1C1 = .Cells(2, 40).FormulaR1C1
   Set PlageAO = .Range(.Cells(7, 41), .Cells(derlig, 41))
    PlageAO.FormulaR1C1 = .Cells(2, 41).FormulaR1C1
   Set PlageAP = .Range(.Cells(7, 42), .Cells(derlig, 42))
    PlageAP.FormulaR1C1 = .Cells(2, 42).FormulaR1C1
   Set PlageAQ = .Range(.Cells(7, 43), .Cells(derlig, 43))
    PlageAQ.FormulaR1C1 = .Cells(2, 43).FormulaR1C1
   Set PlageAR = .Range(.Cells(7, 44), .Cells(derlig, 44))
    PlageAR.FormulaR1C1 = .Cells(2, 44).FormulaR1C1
End With
'remise en place du recalcule automatique
Application.Calculation = xlCalculationAutomatic
End Sub
0
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020
24 août 2015 à 14:25
Ca a bien fonctionné ! merci beaucoup
0