Macro lente suppression de ligne sous conditions

[Acturis]

Bonjour à tous,

J'ai cherché sur le forum une macro permettant de supprimer des lignes si une cellule contient une certaine valeur.

Je suis tombé sur un fil proposant ce code :

Sub Filter()
Dim i As Long
With Sheets("DATA")
For i = Range("U20000").End(xlUp).Row To 2 Step -1
If Cells(i, 21) Like "To delete" Then Rows(i).Delete
Next i
End With
End Sub

Cette Macro fonctionne bien, cependant comme j'ai presque 20000 lignes à vérifier, mon pc s'emballe et la macro met vraiment énormément de temps à s’exécuter.

Quelqu'un aurait il une astuce pour accélérer le processus ? En changeant peut être la logique "For".

Merci d'avance pour votre aide

 

[Jauster]

Bonjour,
A essayer : En désactivant quelques fonctions puis en les réactivant à la fin :

Sub Filter()
Dim i As Long
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

With Sheets("DATA")
    For i = Range("U20000").End(xlUp).Row To 2 Step -1
        If Cells(i, 21) Like "To delete" Then Rows(i).Delete
    Next i
End With

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub

 

[vgendron]

Hello
un essai avec ceci

Sub Filter()

With Sheets("DATA").UsedRange
    .AutoFilter
    .AutoFilter Field:=21, Criteria1:="=To Delete"
    .Offset(1).SpecialCells(xlCellTypeVisible).Delete
    .AutoFilter
End With
End Sub

 

[Jauster]

Hello Vgendron, Re Acturis,

A essayer :

Sub Test()

Dim supprRng As Range, Rng As Range, cell As Range

With Sheets("Data")
    Set Rng = .Range(.Cells(2, "U"), .Cells(.Rows.Count, "U").End(xlUp))
End With

For Each cell In Rng.Cells
    If cell.Value2 = "To Delete" Then
        If supprRng Is Nothing Then
            Set supprRng = cell
        Else
            Set supprRng = Union(supprRng, cell)
        End If
    End If
Next

If Not supprRng Is Nothing Then supprRng.EntireRow.Delete

End Sub

Testé sur 15000 lignes en 1.8 secondes

 

[Acturis]

Bonjour,

Merci à vous deux pour votre réponse rapide =).
La macro de vgendron est vraiment très rapide ! C'est top ! Par contre excel affiche le message "Voulez vous supprimer la ligne" et il faut cliquer sur "Oui". Est-ce possible de ne pas afficher ce message ?
En tout cas merci beaucoup.

 

[Jauster]

Re,

En ajoutant
Application.DisplayAlerts = False au début de la macro et
Application.DisplayAlerts = True en fin de macro

 

[vgendron]

Pour ne pas avoir le message d'alerte

Sub Filter()
Application.DisplayAlerts = False

With Sheets("DATA").UsedRange
    .AutoFilter
    .AutoFilter Field:=21, Criteria1:="=To Delete"
    .Offset(1).SpecialCells(xlCellTypeVisible).Delete
    .AutoFilter
End With
Application.DisplayAlerts = True
End Sub

 

[Jauster]

Pour ne pas avoir le message d'alerte

Sub Filter()
Application.DisplayAlerts = False

With Sheets("DATA").UsedRange
    .AutoFilter
    .AutoFilter Field:=21, Criteria1:="=To Delete"
    .Offset(1).SpecialCells(xlCellTypeVisible).Delete
    .AutoFilter
End With
Application.DisplayAlerts = True
End Sub

Du coup UsedRange n'est pas limité ici ? J'ai l'impression que c'était juste pour m’énerver la dernière fois^^

 

[Acturis]

Vous êtes géniaux ! =)

 

[vgendron]

Du coup UsedRange n'est pas limité ici ? J'ai l'impression que c'était juste pour m’énerver la dernière fois^^

@Jauster vu qu'on a pas de fichier exemple ici pour tester, j'ai fait le test sur 10 lignes.. donc peu de chance que ca bug
et j'avais la flemme d'écrire une ligne de plus pour avoir la dernière ligne.. :-D

 

[Acturis]

Je viens de faire le test sur 15000 lignes et pas de bug =)