Selection.AutoFilter
Selection.AutoFilter Field:=5, Criteria1:="=x"
Rows("2:" & Range("A1").End(xlDown).Row).Delete Shift:=xlUp
Selection.AutoFilter
For ligne = Range("A65535").End(xlUp).Row To 2 Step -1
If Range("E" & ligne).Value = "x" Then
Range("A" & ligne).EntireRow.Delete
End If
Next
For i = Range("E65536").End(xlUp).Row To 2 Step -1
If Cells(i, 5) = "x" Then Cells(i, 5).EntireRow.Delete
Next i
Public Sub ProcessData()
Dim Myrange As Range
Dim CriteriaVal As Variant
Dim KillColumn As Integer
Dim ActiveColumn As String
Dim AC
Dim LastRow As Long
Dim rng As Range
AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
ActiveColumn = AC(0)
KillColumn = InputBox("Entrer la collone a filtrer - Cancel pour sortir ", "Filtre Avec Delete", ActiveColumn)
If Application.CountA(Range("IV:IV")) > 0 Then
MsgBox "There are no spare columns. Macro will exit", vbCritical
Exit Sub
End If
CriteriaVal = InputBox("Donner la valeur a filtrer", "Filter Criteria")
LastRow = Cells(Rows.Count, KillColumn).End(xlUp).Row
Set Myrange = Cells(1, KillColumn).Resize(LastRow)
Myrange.AutoFilter field:=1, Criteria1:=CriteriaVal
On Error Resume Next
Set rng = Cells(2, KillColumn).Resize(LastRow - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
Application.ScreenUpdating = False
If MsgBox("There are " & rng.Cells.Count & " rows to delete. Delete them?", vbYesNo, "Shall we delete") = vbYes Then
rng.EntireRow.Delete
End If
Application.ScreenUpdating = True
End If
Myrange.AutoFilter
End Sub
Sub j()
[A1].CurrentRegion.Select
'poser le filtre si absent
If ActiveSheet.AutoFilter Is Nothing Then Selection.AutoFilter
'appliquer le filtrage pour le champ 5 (field)
Selection.AutoFilter Field:=5, Criteria1:="=x"
'suppression des lignes
Rows("2:" & Range("A1").End(xlDown).Row).Delete Shift:=xlUp
'ôter le filtre
Selection.AutoFilter
End Sub
quand je suis confrontée à des fichiers trop lourds comme vous avec les filtres qui ne fonctionnent plus la mémoire saturée et autres réjouissances, je fais un tri (exemple ici sur la colonne E) puis je supprime d'un coup le bloc dont je ne veux pas.
Salut Stephane, je ne vois pas la différence avec mon code...
C'est tout con mais j'y avais pas pensé ! Je teste tout de suite...
C'est tout con mais j'y avais pas pensé ! Je teste tout de suite...
'Tri des données pour regrouper les lignes à supprimer
Range("A1", Cells(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)).Sort _
Key1:=Range("E1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
'Suppression des lignes
Columns("E:E").Select
Selection.Find(What:="x", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Rows(ActiveCell.Row & ":" & Range("A1").End(xlDown).Row).Delete Shift:=xlUp
'et hop ! on remet tout dans le bon ordre...
Range("A1", Cells(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)).Sort _
Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Essaye la solution que j'ai poste., dit moi si il ya des truc a modifier