XL 2016 Boucle pour supprimer des lignes

[thea_capkrabs]

Bonjour,

Cela fait déjà quelques heures que je passe sur ce bout de code qui malheureusement ne fait pas ce que je souhaite sans comprendre pourquoi .... Je souhaiterai que la boucle supprime les lignes où les colonnes H ou I sont renseignées. J'ai tenté différentes types de boucles : for i=2 to lastline : <>" " ou isempty = false mais pour que le programme me supprime l'intégralité des lignes, il faut cliquer à plusieurs reprises sur le bouton comme si le programme s'arrêtait avant la fin effective des lignes….

Ma dernière tentative est avec la boucle while sans plus de succès :

Sub test()

    Dim Lst As Worksheet
    
    Set Lst = ThisWorkbook.Worksheets("DOSSIERS 14 jrs")


    i = 2
    While IsEmpty(Lst.Range("H" & i)) = False Or IsEmpty(Lst.Range("I" & i)) = False
        Lst.Cells(i, 1).EntireRow.Delete
        i = i + 1
    Wend

End Sub

Voyez vous d'où cela-t-il provenir ?

Merci par avance pour votre aide !

 

[job75]

Bonsoir thea_capkrabs, bienvenue sur XLD,

Nombreux exemples sur ce forum avec des codes de ce genre :

Sub SupprimerLignes()
Dim derlig&, i&
derlig = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
For i = derlig To 1 Step -1
    If Cells(i, "H") <> "" Or Cells(i, "I") <> "" Then Rows(i).Delete
Next
End Sub

Mais si le tableau est très grand cela prend un temps fou.

La bonne méthode est alors d'utiliser un tableau VBA, faites une recherche, il y a de nombreux exemples aussi.

A+

 

[youky(BJ)]

Bonjour et bienvenu sur XLD
Voici un code
Bruno

Sub efface()
Dim lig
'[A65000].End(3).Row renvoie la derligne
For lig = [A65000].End(3).Row To 2 Step -1 'compte à rebour bas en haut
If Cells(lig, 8) <> "" Or Cells(lig, 9) <> "" Then Rows(lig).Delete
Next
End Sub

EDIT comme d'hab je suis devancé Salut Job

 

[job75]

Re, salut Bruno,

Bon pour tester j'ai copié votre tableau sur 22 000 lignes.

Et j'ai mis en début de macro l'instruction Application.ScreenUpdating = False pour accélérer.

Chez moi la macro du post #2 s'exécute en 11 secondes, ce n'est pas encore trop pénible (mon ordi a une RAM de 8 Go).

A+

 

[job75]

Voici la macro avec un tableau VBA :

Sub SupprimerLignesTableauVBA()
Dim ncol%, tablo, i&, n&, j%
With Range("A1", ActiveSheet.UsedRange)
    ncol = .Columns.Count
    If ncol < 9 Then ncol = 9
    tablo = .Resize(, ncol) 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        If Cells(i, 8) & Cells(i, 9) = "" Then
            n = n + 1
            For j = 1 To ncol
                tablo(n, j) = tablo(i, j)
            Next j
        End If
    Next i
    '---restitution---
    Application.ScreenUpdating = False
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    .Value = "" 'RAZ
    If n Then .Resize(n) = tablo
    With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
End Sub

Sur 22 000 lignes elle s'exécute chez moi en 0,25 seconde, y a pas photo !

A+

 

[Staple1600]

Bonsoir le fil, thea_capkrabs, youku(bj), job75

=>thea_capkrabs [Bienvenue sur XLD]
Une autre possibilité (utilisable avec un nombre de lignes pas trop conséquent)

Sub SuppressionLignes()
Dim derlig&
derlig = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
Application.ScreenUpdating = False
With Cells(1, Columns.Count).Resize(derlig)
.FormulaR1C1 = "=IF(COUNTA(RC8:RC9)=2,""$"",0)"
.Value = .Value
.SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
End With
Columns(Columns.Count).Clear
End Sub

Et effectivement tu trouveras des exemples (en bas de page) dans les discussions similaires
et/ou en utilisant le moteur de recherche

Effectuez une recherche sur Excel Downloads...

www.excel-downloads.com

EDITION: J'aurais du rafraîchir la page de mon navigateur.

 

[job75]

Salut JM,

Avec la méthode par formules que tu proposes c'est très rapide aussi même sur un très grand tableau.

Mais il faut faire un tri pour grouper et placer les lignes à supprimer en bas du tableau.

A+

 

[Staple1600]

Re

Job75
Je savais que j'avais lu cela quelque part

https://www.excel-downloads.com/threads/macro-supprimer-lignes-vides.232091/#post-1481760

J'attends de savoir quel code le demandeur utilisera avant de modifier mon précédent code.

 

[Staple1600]

Re

Bon finalement, en attendant que la soupe refroidisse
J'ai repris la macro de Job75 (celle du fil que je cite)
et j'ai juste mis ma formule
Par contre, j'ai commis la seconde macro (pour avoir de quoi tester)
Résultat : 2,23 secondes

Sub SuppressionLigneIJ()
Dim t, P As Range
t = Timer
Set P = ActiveSheet.UsedRange
Application.ScreenUpdating = False
With P.Columns(P.Columns.Count + 1)
  .FormulaR1C1 = "=IF(COUNTA(RC8:RC9)=2,""$"",0)"
  .Value = .Value
  Union(P, .Cells).Sort .Cells, xlAscending 'tri pour accélérer
  On Error Resume Next
  .SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  .Value = ""
End With
Set P = ActiveSheet.UsedRange 'MAJ des barres de défilement
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub
Sub CréationData_pour_Test()
Dim t
t = Array(1, 2, 3, 4, 5, 6, 7, 8, "=IF(MOD(ROW(),16)=0,CHAR(65+COLUMN()),"""")", "=IF(MOD(ROW(),16)=0,CHAR(65+COLUMN()),"""")", 10)
Application.ScreenUpdating = False
Cells(1).Resize(22000, 11) = t
Cells(1).Resize(22000, 11) = Cells(1).Resize(1600, 11).Value
End Sub

 

[thea_capkrabs]

Merci à vous tous pour vos rapides retours et vos propositions les plus optimales ! Finalement le fait de partir de la dernière ligne vers la 1ère semble plus efficace que l'inverse. Je viens de tester la proposition de Bruno, elle fonctionne à merveille !!

 

[job75]

Ben tu vois Bruno, sois content, t'étais pas en retard

Ce qui est bien c'est que notre ami met des "j'aime" partout

 

[youky(BJ)]

JM,
ne t'étrangle pas en buvant ton café.
Job,
Quand j'ai vu que tu étais sur le coup je me suis dit le tablo est pas loin . . .
Par contre je viens d'apprendre un truc le & à la place du And
If Cells(i, 8) & Cells(i, 9) = "" Then
je mettais
If Cells(i, 8)="" and Cells(i, 9) = "" Then
plus rapide à écrire
Bonne journée à tous
Bruno

 

[mapomme]

Bonjour à tous ,

Je m'y mets aussi. Pour ce cas spécifique, une méthode basée sur deux tris consécutifs. Le tri n'affecte pas l'ordre des lignes restantes.
Pour 22 000 lignes, environ 0,17 sec.

Sub SuppLignes_Tri()
Dim derlig&, deb, col
   deb = Timer: Application.ScreenUpdating = False
   If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
   For Each col In Array("h", "i")
      derlig = Cells(Rows.Count, col).End(xlUp).Row
      If derlig > 1 Then
         Range("a1:j" & derlig).Sort key1:=Cells(1, col), order1:=xlAscending, Header:=xlYes
         derlig = Cells(Rows.Count, col).End(xlUp).Row
         If derlig >= 2 Then Rows(2).Resize(derlig - 1).Delete
      End If
   Next col
   MsgBox Format(Timer - deb, "0.00\ sec.")
End Sub

 

[job75]

Bonjour mapomme et les autres,

C'est en effet ici la meilleure solution, la plus rapide et qui conserve les formats.

A+