Autres Macro qui supprime des lignes si une cellule vide

[Debutantexcel8]

Bonjour,

Je suis débutant en excel vba et je souhaiterais savoir si vous pouvez m'aider svp pour le sujet suivant :

J'ai un fichier excel qui a énormément de lignes plus de 400 000 lignes (il s'agit d'un fichier brut que je veux dégrossir et ne garder qu'une sélection de lignes spécifiques avec des mots précis). Les lignes dont je n'ai pas besoin représentent environ 200 000 lignes.

Dans la colonne AN (exemple ci-joint), je cherche une macro qui irait chercher les mots Taxi ou Balai sur toute la colonne AN (énormément de lignes), si elle ne trouve pas ces mots ou si elle trouve que la cellule est vide, alors elle supprime toutes les lignes qui n'ont pas ces mots; merci

 

[mapomme]

Bonsoir @Debutantexcel8 ,

cliquer sur le bouton Init 400 000 initialise 400 000 lignes en colonne AN.

cliquer sur le bouton Conserver taxi et balai ne conserve que les lignes contenant les mots "Taxi" ou "Balai" (les lignes contenant taxidermiste sont éliminées - si vous ne le désirez pas, m'en informer).

Pour 400 000 lignes sources avec près de 50 % de lignes contenant "taxi ou "balai", la durée est d'environ 5,2 sec.

La feuille "Data" n'est là que pour l'initialisation pour l'exemple.

Le code est dans le module de la feuille "Données brutes" :

Sub ConserverLignes()
Dim xrg As Range, t, i&, s, dercol&, debut

   debut = Timer
   Set xrg = Intersect(Columns("an:an"), Me.UsedRange, Rows(2).Resize(Rows.Count - 1))
   t = xrg
   For i = 1 To UBound(t)
      s = ";" & LCase(Replace(t(i, 1), " ", "")) & ";"
      If s Like "*;balai;*" Then
         t(i, 1) = i
      ElseIf s Like "*;taxi;*" Then
         t(i, 1) = i
      Else
         t(i, 1) = Empty
      End If
   Next i
   dercol = Me.UsedRange.Column + Me.UsedRange.Columns.Count
   Application.ScreenUpdating = False
   Cells(xrg.Row, dercol).Resize(UBound(t)) = t
   With Rows(xrg.Row).Resize(UBound(t), dercol)
      .Sort Key1:=.Cells(1, dercol), order1:=xlAscending, Header:=xlNo
      On Error Resume Next
      .Columns(dercol).SpecialCells(xlCellTypeBlanks).Select
      .Columns(dercol).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      .Columns(dercol).Delete
   End With
   MsgBox Format(UBound(t), "#,##0") & " lignes traitées en " & Format(Timer - debut, "0.00\ sec,") & _
      vbLf & vbLf & "il reste " & Format(Application.CountA(Columns("an:an")) - 1, "#,##0\ lignes."), vbInformation
End Sub

 

[Debutantexcel8]

En lançant la macro, j'ai un bug un débogage sur Me dans Me.UsedRange et Me dans Me.UsedRange.Column.
Ya t-il une action que je dois faire ?
Merci

 

[mapomme]

En lançant la macro, j'ai un bug un débogage sur Me dans Me.UsedRange et Me dans Me.UsedRange.Column.
Ya t-il une action que je dois faire ?
Merci

Dans le classeur que j'ai joint ou bien dans votre classeur ?

 

[Debutantexcel8]

Dans mon classeur

 

[job75]

Bonjour Debutantexcel8, mapomme,

Voyez le fichier joint et cette macro dans le code de la feuille "Résultat" :

Private Sub Worksheet_Activate()
With Sheets("Données brutes").UsedRange.EntireRow
    .AutoFilter
    .AutoFilter 40, "*Balai*", xlOr, "*Taxi*"
    .Copy [A1] 'copier-coller
    .AutoFilter 'ôte le filtre
End With
End Sub

Elle se déclenche automatiquement quand on active la feuille.

A+

 

[mapomme]

Dans mon classeur

Comme je l'avais mentionné, la macro doit être mise dans le module rattachée à la feuille "Données brutes" et non dans un module indépendant.

 

[job75]

J'ai testé le fichier du post #6 en recopiant le tableau AN2:AN12 sur 110 000 lignes.

La macro s'exécute en 23 secondes, c'est laborieux, il vaut mieux utiliser la méthode de mapomme.

 

[job75]

Bonsoir Debutantexcel8, mapomme, le forum,

Une solution très voisine de celle de mapomme :

Sub Filtrer()
Dim dercel As Range
Set dercel = Cells.SpecialCells(xlCellTypeLastCell)
Application.ScreenUpdating = False
With Range(Cells(2, dercel.Column + 1), dercel(1, 2))
    If .Row = 1 Then Exit Sub
    .Formula = "=SIGN(IFERROR(SEARCH(""Taxi"",AN2),SEARCH(""Balai"",AN2)))"
    .Value = .Value 'supprime les formules
    .EntireRow.Sort .Cells, xlAscending, Header:=xlNo 'tri pour regrouper et accélérer
    On Error Resume Next
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les valeurs d'erreur
    .ClearContents 'RAZ
End With
End Sub

Testée comme celle de mapomme sur 400 000 lignes : les 2 macros s'exécutent chez moi en 5,4 secondes.

A+

 

[Debutantexcel8]

Bonjour,
Merci beaucoup, beaucoup, la macro ci-dessous fonctionne mais je voudrais savoir si c'est possible de prévoir que la macro ne soit pas limitée à un nombre de lignes ou si ce n'est pas possible mettre une limite plus importante (mon fichier actuel compte 436 000 lignes mais le nombre de lignes évoluera)

Sub Filtrer()
Dim dercel As Range
Set dercel = Cells.SpecialCells(xlCellTypeLastCell)
Application.ScreenUpdating = False
With Range(Cells(2, dercel.Column + 1), dercel(1, 2))
If .Row = 1 Then Exit Sub
.Formula = "=SIGN(IFERROR(SEARCH(""Taxi"",AN2),SEARCH(""Balai"",AN2)))"
.Value = .Value 'supprime les formules
.EntireRow.Sort .Cells, xlAscending, Header:=xlNo 'tri pour regrouper et accélérer
On Error Resume Next
.SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les valeurs d'erreur
.ClearContents 'RAZ
End With
End Sub

 

[mapomme]

si c'est possible de prévoir que la macro ne soit pas limitée à un nombre de lignes

Elle ne l'est pas. Elle s'adapte...

 

[job75]

Oui elle s'adapte en se basant sur le UsedRange (chez mapomme) ou sur la dernière cellule (chez moi).

 

[Debutantexcel8]

Merci beaucoup. clore la demande en résolu

 

[job75]

clore la demande en résolu

C'est à vous de le faire.

Cliquez à droite du post contenant la solution qui vous intéresse, il sera noté en vert.

 

[job75]

A priori le post concerné c'est le post #9.