XL 2013 SUPPRESSION DE LIGNES SOUS CONDITION

MONTREAL2020

XLDnaute Junior
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
 

Pièces jointes

  • test.VBAxlsb.xlsb
    75.6 KB · Affichages: 5

Jacky67

XLDnaute Barbatruc
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)
VB:
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

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

VB:
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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Montreal, Jacky, Chris,
Un essai qui semble plus rapide ( sur mon PC et XL2007 ) avec :
VB:
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.
 

Pièces jointes

  • test.VBAxlsb.xlsb
    486.4 KB · Affichages: 3

MONTREAL2020

XLDnaute Junior
Bonjour Montreal, Jacky, Chris,
Un essai qui semble plus rapide ( sur mon PC et XL2007 ) avec :
VB:
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 :
VB:
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
1637247509788.png
 

Discussions similaires