Macro xls sélection de lignes sous condition

Fermé
Nathalie - 15 janv. 2010 à 11:13
 Nathalie - 18 janv. 2010 à 09:57
Bonjour,

Je cherche à créer une macro excel qui me permettrait de sélectionner des lignes sous condition :
Objectif : faire un tri automatique dans un tableau si colonne A = "E" ET colonne D = "00".

J'ai contourné le pb en copiant le tableau entier, remplaçant les valeurs que je ne voulais pas par " " et ça supprime ensuite les lignes avec les cellules vides. Mais c'est super long et le tableau va être amené à contenir un très grand nombre de lignes et être utilisé en réseau.

Sheets("LISTE DES DIFFUSIONS").Range("A1:AI5000").Copy
Sheets("provisoire").Paste

Sheets("provisoire").Columns("D:D").Replace What:="01", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="02", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="03", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="04", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="05", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="06", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="07", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="08", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="09", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="10", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="11", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="12", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="13", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="14", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="15", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="16", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="17", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="18", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="19", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="20", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="21", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Columns("D:D").Replace What:="22", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("provisoire").Select

Dim l As Long
For l = Cells(5000, 1).End(xlUp).Row To 1 Step -1
If Cells(l, "A").Value = "" _
Then Cells(l, 1).EntireRow.Delete
Next l

For l = Cells(5000, 5).End(xlUp).Row To 1 Step -1
If Cells(l, "D").Value = "" _
Then Cells(l, 1).EntireRow.Delete
Next l

Pouvez-vous m'aider??
A voir également:

4 réponses

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 750
15 janv. 2010 à 11:26
Bonjour,
Tu peux essayer comme suit :

Sub test()
Dim I As Long
Sheets("LISTE DES DIFFUSIONS").Range("A1:AI5000").Copy 
Sheets("provisoire").Paste 
With Sheets("provisoire")
For l = .Cells(5000, 1).End(xlUp).Row To 1 Step -1
If .Range("A" & I).Value = "E" And .Range("D" & I).Value = 00 Then
.Rows(I).Delete
End If
Next I
End With
End Sub

0
Bonjour,

Tout d'abord merci pour la rapidité de ta réponse.

J'ai cependant encore un pb, il m'écrit :
Erreur de compilation
Référence de variable de contrôle incorrecte dans Next et il sélectionne : Next I??
Qu'est-ce que je peux faire?
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 750
15 janv. 2010 à 11:34
faute de frappe... J'ai tapé un L au lieu d'un I. Pardon!!
Remplace :
For l = .Cells(5000, 1).End(xlUp).Row To 1 Step -1

par :
For I = .Cells(5000, 1).End(xlUp).Row To 1 Step -1
0
Merci,

Maintenant, il m'écrit :
Erreur d'exécution "1004" :
Erreur définie par l'application ou par l'objet sur la ligne :

If .Range("A" & I).Value = "E" And .Range("D" & I).Value = 0 Then
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 750
15 janv. 2010 à 11:45
Les cellules de ta colonne "D" sont en quel format? J'imagine que pour avoir 00, 01, 02 tu as pu choisir un format "texte". Si c'est le cas :

If .Range("A" & I).Value = "E" And .Range("D" & I).Value = "00" Then


0
Ca y est, ça ne bug plus, par contre, il copie / colle, mais j'ai toujours mon tableau complet dans ma page provisoire.
Je crois qu'il a juste supprimé une ligne
0
A y regarder de plus près, en fait, il m'a supprimé la seule ligne que je vouais garder c'est à dire :
celle où il y a la valeur "E" en colonne A et la valeur "00" en colonne D.

C'est l'inverse que je veux faire, supprimer toutes les autres. (je voudrai d'ailleurs créer la même macro pour chacunes de 22 valeurs de la colonne "D").
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 750
15 janv. 2010 à 12:16
oups!!
Ce code te fais ce que tu demandes. Il comporte une InputBox demandant à l'utilisateur la valeur de D à conserver : 00, 01, 02 etc...

Sub test()
Dim I As Long
Dim valeur As String
valeur = InputBox("Saisir ici la valeur que vous souhaitez conserver en colonne D. Attention respectez le format 00 ou 01 ou 02 etc...", "Colonne D")
Sheets("Feuil1").Range("A1:AI5000").Copy
Sheets("Feuil2").Paste
With Sheets("Feuil2")
For I = .Cells(5000, 1).End(xlUp).Row To 1 Step -1
If .Range("A" & I).Value = "E" And .Range("D" & I).Value = valeur Then
GoTo suite
Else
.Rows(I).Delete
End If
suite:
Next I
End With
End Sub

0
MERCI!!!

C'est génial, ça marche, merci infiniment pour ton aide et le temps passé à me répondre...

En effet, il n'y a pas de pb sans solution!
0
Re,

Je me permets de te relancer, en fait, ça marche sur mon ordi (bien qu'un peu lent car beaucoup de lignes à effacer), mais comme c'est un fichier qu'on utilise en réseau, ça bug quand je le mets sur le serveur, en fait c'est super long et ça finit par planter (au bout d'une dizaine de minutes)

Il n'y aurait pas un autre moyen pour faire la même chose mais en sélectionnant directement dans la base de données uniquement les lignes qui contiennent "E" en colonne A et "la valeur comprise dans l'inoutbox" en colonne D et les colles les unes à la suite des autres dans la deuxième feuille?
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 750 > Nathalie
15 janv. 2010 à 14:42
J'ai modifié la procédure. Maintenant on passe par le filtre automatique d'Excel (j'aurais du commencer par là...). On filtre puis on copie/colle le résultat (grâce au code de l'excellent lermite222 trouvé ici) dans la feuille "provisoire" :
NOTA : cela implique que toutes (ou presque) tes cellules de A1 à AI5000 soient complétées...
Essaye, tu me diras ce que tu en penses...

Sub filtre()
Dim valeur As String
Dim CelR As Range
Sheets("LISTE DES DIFFUSIONS").Select
valeur = InputBox("Saisir ici la valeur que vous souhaitez conserver en colonne D. Attention respectez le format 00 ou 01 ou 02 etc...", "Colonne D")
Range("A1:AI1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="E"
    Selection.AutoFilter Field:=4, Criteria1:=valeur
Set CelR = ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible)
CelR.Select
a = CelR.Address
If Len(a) > 11 Then
    CelR.Copy Sheets("provisoire").Range("A1")
End If
Sheets("LISTE DES DIFFUSIONS").Select
Range("A1:AI1").Select
    Selection.AutoFilter
End Sub

0
Nathalie > pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024
18 janv. 2010 à 09:57
Bonjour,

Je réponds un peu tard désolée, mais j'ai eu un we assez chargé.

Bref, j'ai regardé avec le code que tu m'as donné, il me donne un message d'erreur :
Erreur d'exécution 1004 :
La méthode autofilter de la classe range a échoué

Il me sélectionne la ligne
Selection.AutoFilter Field:=4, Criteria1:=valeur

Sais-tu ce que je peux faire?
0