Supprimer lignes

Re,

La méthode avec filtrage est basée sur un tri via l'autofilter puis la suppression du bloc de lignes contenant "Court-métrage" en filtrant sur le format du film.

En faite l'autofilter est inutile : il suffit de faire le tri et de supprimer le bloc désiré.

Cette méthode v2 divise les durées d'exécution par 2 par rapport à la v1 (avec colonne auxiliaire). Cependant l'ordre relatif des lignes restantes est modifié par rapport à la l'ordre initial. La v1 conserve l'ordre initial après suppression des lignes.

Le code de la v2 (plus concis que la v1) :

Sub SupprCourtMetrageTri()
Dim derlig&, n&, i1&, deb#, tps$

   deb = Timer                                  ' top départ pour mesurer le temps d'exécution
   Application.ScreenUpdating = False           ' plus rapide (écran figé)
   With Worksheets("Feuil1")
      .Select                                                     ' sélectionne la feuille
      If .FilterMode Then .ShowAllData                            ' si filtrage, on affiche tout
      n = Application.CountIf(.Columns("e:e"), "Court-métrage")   ' nombre de termes dont la ligne doit être supprimée
      If n = 0 Then Exit Sub                                      ' pas de ligne à supprimer, on quitte
      derlig = .Cells(Rows.Count, "b").End(xlUp).Row              ' dernière ligne de la colonne A
      .[a1].Resize(derlig, 5).Sort .[e1], MatchCase:=False, Header:=xlYes  ' tri selon la colonne E
      ' recherche de la première position de "Court-métrage" dans i1
      i1 = Application.Match("Court-métrage", .Columns("e:e"), 0)
      ' avec la première position de "Court-métrage" i1 et le nombre de "Court-métrage", on supprime le bloc
      .Cells(i1, 1).Resize(n, 5).Delete shift:=xlShiftUp
      tps = Format(Timer - deb, "#,##0.0\ s.")
      i1 = Application.Match(.[i1], .Range("g1:g99"), 0)
      .Cells(i1, "h") = tps
      [g5].Font.Color = RGB(0, 0, 255)
      MsgBox Format(n, "#,##0") & " lignes supprimées en " & tps
   End With
End Sub
Rechercher des sujets similaires à "supprimer lignes"