Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

suppression d'une ligne suivant un critère => trop trop long..

8 réponses
Avatar
fuzzy
Bonjour,

Apr=E8s un import de donn=E9es (20000 lignes), je souhaite supprimer
certaines lignes en fonction du contenu d'une colonne afin d'all=E9ger
consid=E9rablement le fichier. (au final il doit me rester 300 lignes)

J'ai donc fait tr=E8s simplement cela :


For i =3D 2 To line_fmpro

Select Case Worksheets("fmpro").Range(Cells(i, 2), Cells(i,
2)).Value
Case "toto" ' on conserve les lignes
correspondant =E0 l'expression de ces 5 premiers Case
Case "tata"
Case "titi"
Case "tutu"
Case "tyty"
Case Else ' on vire tout le reste
Selection.EntireRow.Delete
End Select

Mais c'est hyper long, je vois les lignes se supprimer au rythme
effr=E9n=E9 de 1 par seconde !! =3D> est ce normal, y a t'il un autre
moyen ?

Merci,
Roaduster.

8 réponses

Avatar
Jacky
Bonjour,

Environ 30 secondes pour 20 000 lignes
Il y a sûrement mieux.....en attendant ceci
les noms à supprimer sont supposés en colonne A
'------------
Sub jj()
Application.ScreenUpdating = False
For i = [a65536].End(3).Row To 2 Step -1
If Cells(i, 1) <> "toto" And Cells(i, 1) <> "tata" And Cells(i, 1) <> "tutu"
And Cells(i, 1) <> "tyty" Then
Rows(Cells(i, 1).Row).Delete
End If
Next
End Sub
'-----------------

--
Salutations
JJ


"fuzzy" a écrit dans le message de news:

Bonjour,

Après un import de données (20000 lignes), je souhaite supprimer
certaines lignes en fonction du contenu d'une colonne afin d'alléger
considérablement le fichier. (au final il doit me rester 300 lignes)

J'ai donc fait très simplement cela :


For i = 2 To line_fmpro

Select Case Worksheets("fmpro").Range(Cells(i, 2), Cells(i,
2)).Value
Case "toto" ' on conserve les lignes
correspondant à l'expression de ces 5 premiers Case
Case "tata"
Case "titi"
Case "tutu"
Case "tyty"
Case Else ' on vire tout le reste
Selection.EntireRow.Delete
End Select

Mais c'est hyper long, je vois les lignes se supprimer au rythme
effréné de 1 par seconde !! => est ce normal, y a t'il un autre
moyen ?

Merci,
Roaduster.
Avatar
Jacky
Re...
Moins d'une seconde avec un filtre élaboré
'------------------
Sub Macro1()
Columns("B:B").Insert Shift:=xlToRight
[A1:A30000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("nom"), CopyToRange:=[b1], Unique:úlse
Sheets("resultat").Activate
Sheets("bd").Range("b:b").Copy [a1]
Sheets("bd").Columns("B:B").Delete
End Sub
'--------------------
Exemple ici
http://cjoint.com/?iwackhAnpo

--
Salutations
JJ


"fuzzy" a écrit dans le message de news:

Bonjour,

Après un import de données (20000 lignes), je souhaite supprimer
certaines lignes en fonction du contenu d'une colonne afin d'alléger
considérablement le fichier. (au final il doit me rester 300 lignes)

J'ai donc fait très simplement cela :


For i = 2 To line_fmpro

Select Case Worksheets("fmpro").Range(Cells(i, 2), Cells(i,
2)).Value
Case "toto" ' on conserve les lignes
correspondant à l'expression de ces 5 premiers Case
Case "tata"
Case "titi"
Case "tutu"
Case "tyty"
Case Else ' on vire tout le reste
Selection.EntireRow.Delete
End Select

Mais c'est hyper long, je vois les lignes se supprimer au rythme
effréné de 1 par seconde !! => est ce normal, y a t'il un autre
moyen ?

Merci,
Roaduster.
Avatar
cousinhub
Bonjour Jacky, le forum
Un peu moins de lignes, il suffit de se placer dans la feuille
"resultat" avant le filtre, et voili :

Sub Macro1()
Sheets("resultat").Activate
Sheets("bd").[A1:A30000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("nom"), CopyToRange:=[a1], Unique:úlse
End Sub

Bonne journée

Re...
Moins d'une seconde avec un filtre élaboré
'------------------
Sub Macro1()
Columns("B:B").Insert Shift:=xlToRight
[A1:A30000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("nom"), CopyToRange:=[b1], Unique:úlse
Sheets("resultat").Activate
Sheets("bd").Range("b:b").Copy [a1]
Sheets("bd").Columns("B:B").Delete
End Sub
'--------------------
Exemple ici
http://cjoint.com/?iwackhAnpo



Avatar
Jacky
Re,

Merci cousinhub.
Faut dire que j'ignore tout ou presque, des filtres,
même élaboré
;o)

--
Salutations
JJ


"cousinhub" a écrit dans le message de news:

Bonjour Jacky, le forum
Un peu moins de lignes, il suffit de se placer dans la feuille "resultat"
avant le filtre, et voili :

Sub Macro1()
Sheets("resultat").Activate
Sheets("bd").[A1:A30000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("nom"), CopyToRange:=[a1], Unique:úlse
End Sub

Bonne journée

Re...
Moins d'une seconde avec un filtre élaboré
'------------------
Sub Macro1()
Columns("B:B").Insert Shift:=xlToRight
[A1:A30000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("nom"), CopyToRange:=[b1], Unique:úlse
Sheets("resultat").Activate
Sheets("bd").Range("b:b").Copy [a1]
Sheets("bd").Columns("B:B").Delete
End Sub
'--------------------
Exemple ici
http://cjoint.com/?iwackhAnpo





Avatar
cousinhub
Bonjour, regarde le fichier de JB, très complet.

http://www.excelabo.net/moteurs/compteclic.php?nom=jb-filtreelabore


Bonne lecture

Re,

Merci cousinhub.
Faut dire que j'ignore tout ou presque, des filtres,
même élaboré
;o)



Avatar
Jacky
Re...
Merci à toi,
J'étais en train de le consulter
Source inépuisable, JB
Merci à lui

--
Salutations
JJ


"cousinhub" a écrit dans le message de news:

Bonjour, regarde le fichier de JB, très complet.

http://www.excelabo.net/moteurs/compteclic.php?nom=jb-filtreelabore


Bonne lecture

Re,

Merci cousinhub.
Faut dire que j'ignore tout ou presque, des filtres,
même élaboré
;o)





Avatar
fuzzy
Et bien messieurs, merci à tous, cela fonctionne bien mieux
maintenant !!

Roadbuster.
Avatar
fuzzy
Bonjour,

Merci pour la réponse, c'est presque cela mais pas tout à fait : je
souhaite garder le contenu entier de la ligne (qui s'étale sur une
trentaine de colonnes)
J'ai essayé de modifier l'exemple ci-dessous sans gd succès..

Fuzzy.


Re...
Moins d'une seconde avec un filtre élaboré
'------------------
Sub Macro1()
Columns("B:B").Insert Shift:=xlToRight
[A1:A30000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("nom"), CopyToRange:=[b1], Unique:úlse
Sheets("resultat").Activate
Sheets("bd").Range("b:b").Copy [a1]
Sheets("bd").Columns("B:B").Delete
End Sub
'--------------------