Rendre une macro plus rapide

Résolu
ti_mouton Messages postés 153 Statut Membre -  
ti_mouton Messages postés 153 Statut Membre -
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

1 réponse

  1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    1. ti_mouton Messages postés 153 Statut Membre
       
      Ca a bien fonctionné ! merci beaucoup
      0