XL 2013 Supprimer ligne

maval

XLDnaute Barbatruc
Bonjour,


Je souhaiterai, via une macro, que toutes les lignes ne contenant pas " 2019" dans la colonne "L" soit supprimées:

J´ai trouver ce code "qui est Très lent"


Sub Supprimer ligne()

Dim i%
For i = 25000 To 5 Step -1
If Cells(i, 12).Value <> "2019" Then Rows(i).EntireRow.Delete
Next i
End Sub


mais je pense pas qu'il à était fait pour environ 350 000 lignes et 17 colonne
Je vous remercie d'avance

Max
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Il sffit de replacer <> par =

VB:
  t = Timer()
  Application.ScreenUpdating = False
  a = Range("A2:A" & [A65000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If a(i, 1) = "xxxx" Then a(i, 1) = 0 Else a(i, 1) = "sup"
  Next i
  Columns("b:b").Insert Shift:=xlToRight
  [B2].Resize(UBound(a)) = a
  [A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
  On Error Resume Next
  Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
  MsgBox Timer() - t
End Sub

Boisgontier
 

Pièces jointes

  • Copie de SupLignesRapide-3.xls
    37.5 KB · Affichages: 7

job75

XLDnaute Barbatruc
Bonjour maval, JB,

Avec un tableau de 350 000 lignes cette macro s'exécute chez moi en 4 secondes( 1 ligne sur 2 supprimée) :
VB:
Sub SupprimerLignes()
Dim crit, ligdeb&, P As Range
crit = 2019 'à adapter (nombre ou texte)
ligdeb = 5 '1ère ligne à traiter
With ActiveSheet 'à adapter
    Set P = Intersect(.Rows(ligdeb & ":" & .Rows.Count), .UsedRange.EntireRow)
End With
Application.ScreenUpdating = False
ThisWorkbook.Names.Add "Critere", crit 'nom défini
P(1).EntireColumn.Insert
P.Columns(1) = "=1/(RC[12]=Critere)" 'si recherche exacte
'P.Columns(1) = "=1/ISNUMBER(SEARCH(Critere,RC[12]))" 'si recherche partielle
P.Columns(1) = P.Columns(1).Value 'supprime les formules
P.Sort Columns(1) 'tri pour regrouper et accélérer
On Error Resume Next 'si aucune SpecialCell
P.Columns(1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
P(1).EntireColumn.Delete
End Sub
A+
 
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Pour 350.000 lignes et 2/3 des lignes supprimées: 2 secondes

VB:
Sub supLignesRapide2()
  Application.ScreenUpdating = False
  a = Range("L2:L" & [L1000000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If a(i, 1) = 2019 Then a(i, 1) = 0 Else a(i, 1) = "sup"
  Next i
  Columns("b:b").Insert Shift:=xlToRight
  [B2].Resize(UBound(a)) = a
  [A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
  On Error Resume Next
  Range("B2:B1000000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
End Sub

Boisgontier
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 847
dernier inscrit
Djigbenou