XL 2013 SUPPRESSION DE LIGNES SOUS CONDITION

[MONTREAL2020]

Bien le bonjour à vous,

Je sollicite votre aide pour une macro Excel
Il s'agit d'une code que j'ai pu avoir sur le site Excel Downloads, ça fonctionne très bien néanmoins l'exécution prend pas mal de temps.
y'aurait-il moyen de l'améliorer.

J'ai joins un fichier excel, qui fait appel à un autre fichier pour récupérer des données, donc plusieurs formules de recherche et des MFC et je pense que c'est ce qui ralenti l'exécution de la macro. J'ai tenté de mettre le calcul manuel, mais cela n'améliore pas trop les choses.



Je vous remercie par avance.



Sub Suppr()
Dim n&, i&
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'évite le recalcul des formules
With ActiveSheet 'Avec la feuille active
n = .Range("A" & .Rows.Count).End(xlUp).Row 'je recherche la dernière ligne remplie de la colonne A
For i = n To 2 Step -1 'Je boucle sur chaque cellule de la colonne AR en partant du bas vers le haut (ligne2) (STEP -1 pour remonter ligne par ligne
'Si dans la colonne AR et la ligne, il y a le mot OUT, je supprime la ligne
If Range("AR" & i).Value = "OUT" Then .Range("AR" & i).EntireRow.Delete
Next i
End With
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Jacky67]

Bien le bonjour à vous,

Je sollicite votre aide pour une macro Excel
Il s'agit d'une code que j'ai pu avoir sur le site Excel Downloads, ça fonctionne très bien néanmoins l'exécution prend pas mal de temps.
y'aurait-il moyen de l'améliorer.

J'ai joins un fichier excel, qui fait appel à un autre fichier pour récupérer des données, donc plusieurs formules de recherche et des MFC et je pense que c'est ce qui ralenti l'exécution de la macro. J'ai tenté de mettre le calcul manuel, mais cela n'améliore pas trop les choses.



Je vous remercie par avance.



Sub Suppr()
Dim n&, i&
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'évite le recalcul des formules
With ActiveSheet 'Avec la feuille active
n = .Range("A" & .Rows.Count).End(xlUp).Row 'je recherche la dernière ligne remplie de la colonne A
For i = n To 2 Step -1 'Je boucle sur chaque cellule de la colonne AR en partant du bas vers le haut (ligne2) (STEP -1 pour remonter ligne par ligne
'Si dans la colonne AR et la ligne, il y a le mot OUT, je supprime la ligne
If Range("AR" & i).Value = "OUT" Then .Range("AR" & i).EntireRow.Delete
Next i
End With
Application.Calculation = xlCalculationAutomatic
End Sub

Bonjour,
Essaye comme ceci (avec un filtre)

Sub Suppr()
    Dim Plage
    With Sheets("Commande")
        Set Plage = .UsedRange
        On Error Resume Next    ' rien a filtrer
        Plage.AutoFilter Field:=44, Criteria1:="OUT"
        Plage.Offset(1).Resize(Plage.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        Plage.AutoFilter
    End With
End Sub

 

[Chris401]

Bonjour à tous
Comme je l'ai préparé, je le poste

Sub Suppr()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim n&
     With ActiveSheet
     On Error Resume Next
        n = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A1:AT" & n).AutoFilter 44, "OUT"
        .Rows("2:" & n).SpecialCells(xlCellTypeVisible).Delete
        .ShowAllData
    End With
Application.Calculation = xlCalculationAutomatic
End Sub

 

[MONTREAL2020]

Merci pour votre réponse rapide

Jacky67 et Chris401

​

Ça marche super bien

 

[sylvanu]

Bonjour Montreal, Jacky, Chris,
Un essai qui semble plus rapide ( sur mon PC et XL2007 ) avec :

Sub SupprSylvanu()
    Dim DL%
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    DL = Sheets("Commande").Range("A65500").End(xlUp).Row      ' Dernière ligne
    With Sheets("Commande").Range("ZZ2:ZZ" & DL)
        .FormulaR1C1 = "=IF(RC[44]=""OUT"",1,"""")"         ' Si OUT en AR alors 1 sinon vide
        .Value = .Value                                     ' Supprime les formules
        .EntireRow.Sort .Cells, xlDescending, Header:=xlNo  ' Tri pour regrouper et placer les 1 en bas
        On Error Resume Next                                ' Si pas de OUT
        .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete ' Supprime les lignes avec 1
        .ClearContents                                      ' Supprime la colonne ajoutée
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

La PJ enchaine trois macros et mesure les temps d'éxecution.

 

[MONTREAL2020]

Bonjour Montreal, Jacky, Chris,
Un essai qui semble plus rapide ( sur mon PC et XL2007 ) avec :

Sub SupprSylvanu()
    Dim DL%
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    DL = Sheets("Commande").Range("A65500").End(xlUp).Row      ' Dernière ligne
    With Sheets("Commande").Range("ZZ2:ZZ" & DL)
        .FormulaR1C1 = "=IF(RC[44]=""OUT"",1,"""")"         ' Si OUT en AR alors 1 sinon vide
        .Value = .Value                                     ' Supprime les formules
        .EntireRow.Sort .Cells, xlDescending, Header:=xlNo  ' Tri pour regrouper et placer les 1 en bas
        On Error Resume Next                                ' Si pas de OUT
        .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete ' Supprime les lignes avec 1
        .ClearContents                                      ' Supprime la colonne ajoutée
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

La PJ enchaine trois macros et mesure les temps d'éxecution.

Bonjour Montreal, Jacky, Chris,
Un essai qui semble plus rapide ( sur mon PC et XL2007 ) avec :

Sub SupprSylvanu()
    Dim DL%
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    DL = Sheets("Commande").Range("A65500").End(xlUp).Row      ' Dernière ligne
    With Sheets("Commande").Range("ZZ2:ZZ" & DL)
        .FormulaR1C1 = "=IF(RC[44]=""OUT"",1,"""")"         ' Si OUT en AR alors 1 sinon vide
        .Value = .Value                                     ' Supprime les formules
        .EntireRow.Sort .Cells, xlDescending, Header:=xlNo  ' Tri pour regrouper et placer les 1 en bas
        On Error Resume Next                                ' Si pas de OUT
        .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete ' Supprime les lignes avec 1
        .ClearContents                                      ' Supprime la colonne ajoutée
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

La PJ enchaine trois macros et mesure les temps d'éxecution.

Merci beaucoup Sylvanu,
Mais la macro bloque

 

[sylvanu]

Sur mon PC pas de souci.
Mon fichier fait 10000 lignes, j'ai remplacé dans votre macro i& par i%, mais cela ne devrait pas jouer.
Essayez celle ci. Moi, j'obtiens ça :

 

[Chris401]

Re
Même message que Montreal
Bloque à next i (valeur : 9383)

 

[sylvanu]

Je ne comprends pas i% peut aller jusqu'à 32768.
Chez moi ça marche impec.
Pouvez vous remplacer le i% par i dans la macro de Montreal, svp ?

 

[Chris401]

Alors le vrai problème n'est pas que ça bloque mais je suis obligé d'interrompre car pas de réponse au bout de 5 mn !!!

 

[sylvanu]

Oups, j'ai compris. Ma PJ fait 10000 lignes et la macro de Montreal est très lente.
En PJ j'ai limité à 1000 lignes. Mais les écarts sont plus faibles donc moins appréciables.

 

[Chris401]

Voilà : la macro a tourné.
Pas photo : ton code est plus rapide.

 

[Jacky67]

Moi, j'obtiens ça :
Regarde la pièce jointe 1122059

=RE
En ajoutant la mienne de macro

Win 10 et Xl2007
En ajoutant screen et Calculation

 

[MONTREAL2020]

Ben, je n'y comprends pas grand chose,

Mais mille mercis à vous tous.

Ça roule comme sur des roulettes