macro suppression de lignes

[Meryl]

Bonjour,

Ma requete est la suivante : je travaille actuellement sur un tableau à x lignes et je souhaiterais trouver une macro qui me permette de ne conserver que les lignes qui m'intéressent et de supprimer toutes les autres.

Rien ne vaut une illustration donc j'ai mis un fichier en PJ qui résume parfaitement ma problématique.

Merci d'avance pour votre contribution

Meryl [file name=merylmacro.zip size=2850]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/merylmacro.zip[/file]

 

[Staple1600]

Bonjour

Un début de solution


Avec
Select Case

et

Selection.Delete Shift:=xlUp


(plus de détails, quand j'aurais bu mon café)

 

[Meryl]

Bonjour Staple1600

Merci pour ton début de réponse, mais, pour être honnête, ça m'avance pas du tout: je suis une bille en programmation... c'est du chinois pour moi.

Donc je vais patiemment attendre la fin de ta pause café...

Meryl

 

[Staple1600]

Voici une première ébauche

Sans Select Case

Mais avec un petit souci...
(donc à essayer sur une copie du classeur)

Sub deleteR()
'6, 344, 564, 22, 5667
Dim i As Long, LastRow As Long
Application.ScreenUpdating = False
'finds last used row in column A
LastRow = Range('A65536').End(xlUp).Row
'begin loop to check each row for column A value <> 6, 344, 564, 22, 5667

For i = LastRow To 1 Step -1
If Cells(i, 'A') <> 6 And Cells(i, 'A') <> 344 And Cells(i, 'A') <> 564 And Cells(i, 'A') <> 22 And Cells(i, 'A') <> 5667 Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub

source du code original:
http://www.eng-tips.com/viewthread.cfm?qid=131349&page=1

Message édité par: staple1600, à: 23/08/2005 15:33

 

[2passage]

Bonjour,

voici l'adaptation d'un truc qui trainait chez moi :

Dim selstr As String
For Each ligne In ActiveSheet.Range('A3:A' & Range('A65536').End(xlUp).Row).Rows
If Cells(ligne.Row, 1).Text <> '6' And Cells(ligne.Row, 1).Text <> '344' And Cells(ligne.Row, 1).Text <> '564' And Cells(ligne.Row, 1).Text <> '22' And Cells(ligne.Row, 1).Text <> '5667' Then
    If selstr <> '' Then
        selstr = selstr & ',' & ligne.Row & ':' & ligne.Row
    Else
        selstr = ligne.Row & ':' & ligne.Row
    End If
End If
Next
Range(selstr).Select
'Selection.Delete

en l'état, ca selectionne, si tu veux supprimer directement, enleve l'apostrophe devans selection.delete...
A+ [file name=merylmacro2.zip size=10467]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/merylmacro2.zip[/file]

 

[Meryl]

Merci Staple1600 et 2passage,

TOut fonctionne OK.

@+

Meryl