Ma macro supprime trop de lignes et plante

Dut

XLDnaute Nouveau
Bonjour,
dans une feuille, à l'intérieur d'une macro je souhaite supprimer toutes les lignes qui comporte un "x" dans la colonne E. J'avais donc prévu le code suivant :
Code:
    Selection.AutoFilter
    Selection.AutoFilter Field:=5, Criteria1:="=x"
    Rows("2:" & Range("A1").End(xlDown).Row).Delete Shift:=xlUp
    Selection.AutoFilter

Le problème c'est que mon PC au bureau n'est pas une bête de course et il plante systématiquement quand j'arrive sur cette instruction. Apparemment il n'apprécie pas devoir supprimer environ 17000 lignes (sur 43000).

J'ai essayé d'effectuer la manip à la main pour voir et j'obtiens le message d'erreur :
"Microsoft Excel ne peut pas créer ni utiliser la plage de données car celle-ci est trop complexe"

Sauriez-vous comment résoudre ce souci ?
 

2passage

XLDnaute Impliqué
Re : Ma macro supprime trop de lignes et plante

Bonjour,

essaye plutot :
Code:
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
 

ninbihan

XLDnaute Impliqué
Re : Ma macro supprime trop de lignes et plante

Bonjour DUT,

Peut être avec une boucle, le traitement sera plus long mais peut être plus efficace. A tester:

Code:
For i = Range("E65536").End(xlUp).Row To 2 Step -1
If Cells(i, 5) = "x" Then Cells(i, 5).EntireRow.Delete
Next i

Bon app !!

Ninbihan

Edit: Bonjour Pascal et 2passage, et paf je suis en retard !!!
 

Dut

XLDnaute Nouveau
Re : Ma macro supprime trop de lignes et plante

Merci les gars mais si j'ai choisi la solution du filtre à celle de la boucle c'est parce que le temps de réponse dans le 2è cas est inacceptable.

43000 itérations avec 17000 suppressions de lignes je vous suggère de tenter sur vos PC... chez moi ça dure presque 30min !

:confused:
 

teodormircea

XLDnaute Occasionnel
Re : Ma macro supprime trop de lignes et plante

Essaye cette solution , je l'utilise ca marche tres bien
Code:
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
 

mth

XLDnaute Barbatruc
Re : Ma macro supprime trop de lignes et plante

Bonjour dut, le forum :)

Juste une petite idée, 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. Je le fais à la mimine et je suis désolée de ne pas vous joindre les lignes de code qui vont bien car je ne pense pas savoir écrire ça (trouver la première ligne avec un x, puis la dernière, puis supprimer le bloc) mais au cas où.... c'était juste pour lancer l'idée ...
Bon courage,
Mth
 

STephane

XLDnaute Occasionnel
Re : Ma macro supprime trop de lignes et plante

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
 

2passage

XLDnaute Impliqué
Re : Ma macro supprime trop de lignes et plante

euh... le code que j'ai mis est copié d'une macro que j'utilise et qui supprime environ 700 lignes sur 11000.. ça prends 30s maxi... C'est pour ça que je n'ai même pas pris la peine de couper le screen updating.
Sinon, j'ai utilisé l'itération parce que le code (que j'ai du poster ici il y a un moment) qui ajoutait les lignes à la sélection avant de la supprimer plante dès que le range à sélectionner devient trop long. Je pense donc que ton problème est le même : pour sélectionner 700 lignes, l'expression définissant le range fait plus de 6500 caractères...
D'après ce que je viens de tester, au dela de 255 caractères, ça commence à déconner : "debug.print selection.address" ne retourne que les 251 premiers caractères d'une selection complexe par exemple.

L'idée de mth me parait la plus optimale, par contre... limite je m'en veut de ne pas y avoir pensé :)
 
Dernière édition:

Dut

XLDnaute Nouveau
Re : Ma macro supprime trop de lignes et plante

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

Salut Stephane, je ne vois pas la différence avec mon code... :rolleyes:



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.

C'est tout con mais j'y avais pas pensé ! Je teste tout de suite... :D
 

STephane

XLDnaute Occasionnel
Re : Ma macro supprime trop de lignes et plante

bonjour,

j'ai fait une correction pour éviter qu'il plante si le filtre est déjà posé.
sinon ton code marche très bien.

il faut prendre soin de bien spécifier l'index du champ Field:=n
si aucun filtre n'est posée sur la colonne n, le code plante.

steph
 

mth

XLDnaute Barbatruc
Re : Ma macro supprime trop de lignes et plante

Salut Stephane, je ne vois pas la différence avec mon code... :rolleyes:





C'est tout con mais j'y avais pas pensé ! Je teste tout de suite... :D


Sourire .... c'est mon point fort Dut, j'essaie de compenser mes incompétences excel par mon imagination ...
Ceci dit, au cas où, je suis désolée de ne pouvoir vous aider car cela dépasse mon niveau de compétence, mais je serais intéressée par votre code, si vous n'y voyez pas d'inconvénient bien sûr, je me permettrais de vous demander à l'occasion de le déposer sur ce fil pour m'en inspirer...
Un grand merci d'avance et bon courage,

Mth
 

Dut

XLDnaute Nouveau
Re : Ma macro supprime trop de lignes et plante

C'est tout con mais j'y avais pas pensé ! Je teste tout de suite... :D

La solution mth fonction nickel et le temps de réponse est incroyablement court ! Comme quoi c'est parfois tout bête... :p

Voici le code final :
Code:
    '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


Merci beaucoup !! :)
 

Statistiques des forums

Discussions
312 483
Messages
2 088 780
Membres
103 961
dernier inscrit
sarrent74