Supp ligne si cellule contient "X"

  • Initiateur de la discussion Pedro'
  • Date de début
P

Pedro'

Guest
Bonjour à tous,

J’ai un tableau avec 4 colonnes pouvant contenir 4 infos différentes (X,Y,Z,W)
Exemple :
c1 c2 c3 c4
X Y Z W
W
X Z
Z Y W
X Z W Y

J’aimerai copier dans un autre tableau la ligne entière si une des 4 cellules de la ligne contient « X » par exemple.
Comment puis-je m’y prendre pour faire cette macro.

Merci d’avance
:)
 

le Fnake

XLDnaute Junior
Bonjour Pedro, le forum

En principe, un truc dans ce style devrait convenir, à adapter selon tes besoins
Code:
Sub tri()
'en se basant sur des données de la feuil1 sur les colonnes A à D, en les déplacant vers la Feuil2

Nb = 1 ' données déplacées sur la première ligne de la feuil2
derligne = Range('Feuil1!A1').End(xlDown).Row
' donne la derniere ligne où il y a des donnés
' peut être remplacé par valeur si celle ci est determiné et constante

For i = 1 To derligne
' parcours toutes les lignes (commencer à une autre ligne que 1 éventuellement)
    If Range('Feuil1!A' & i).Value = 'X' Or Range('Feuil1!B' & i).Value = 'X' Or Range('Feuil1!C' & i).Value = 'X' Or Range('Feuil1!D' & i).Value = 'X' Then
     Range('Feuil1!A' & i).EntireRow.Copy Range('Feuil2!A' & Nb)
     Nb = Nb + 1
    End If
Next

End Sub
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour Pedro, le Fnake, le Forum

Je me suis permis de revoir ton code car faire la référence à la feuille et à la cellule comme ceci 'Range('Feuil1!A1')' est plutôt anti-conventionel dans la Programmation VBA pour Excel. Bien que VBA te permette une telle syntax, elle est tout de même à déconseiller, ne fusse qu'au niveau optimisation, car, de la sorte, tu fais une nouvelle instance à un objet Feuille à chaque référence à une cellule.

Voici comment je m'y prendrais pour le même style de structure de code :

Option Explicit
Option Compare Text

Sub Tri()
Dim DerLigne As Integer
Dim Nb As Integer
Dim i As Integer
Dim c As Byte


   
With Sheets('Feuil1')
   
        Nb = 1
        DerLigne = .Range('A1').End(xlDown).Row
       
           
For i = 1 To DerLigne
               
For c = 1 To 4
                   
If .Cells(i, c).Value = 'X' Then
                          .Rows(i).Copy Destination:=Sheets('Feuil2').Rows(Nb)
                          Nb = Nb + 1
                         
Exit For
                   
End If
               
Next c
           
Next i
   
   
End With
End Sub


Bon Après Midi
@+Thierry
 

le Fnake

XLDnaute Junior
ok merci Thierry pour ce complément d'information, car c'est vrai que je ne préoccupe pas toujours de l'optimisation (en terme de temps de calcul notamment) de mes macros. Mais du coup j'ai tendance à prendre de mauvaises habitudes :S

J'en prends note soigneusement :)
 

STephane

XLDnaute Occasionnel
bonjour

Quelle est la solution la plus rapide ?
La tienne Thierry ou celle de Fnake ?
Et si on utilise application.worksheetfunction.or (.....), cela change-t-il quelquechose ?


On peut aussi filtrer la liste en créant au préalable une plage de critères.
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonsoir à Tous,

;) STéphane, et bien tu es un filou !!! lol Mais en fait je le savais déjà !

Bon alors pour me faire pardonner, voilà un petit Jeu ci-joint !

Et on verra que finalement le code de Fnake est un tantinet plus rapide ou kif kif selon les machines !!! Ouai ouai !!! lol

Mais bon, on peut toujours être plus rapide !!! ;)

Voir par exemple ce Fil Lien supprimé où justement un auto-filter à 'scotché' tout le monde au poteau !!

Bon Je vous laisse vous amuser ! Just For The Fun !!!

@+Thierry [file name=XLDTestBoucleTimer.zip size=15341]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/XLDTestBoucleTimer.zip[/file]
 

Pièces jointes

  • XLDTestBoucleTimer.zip
    15 KB · Affichages: 15

Hervé

XLDnaute Barbatruc
Bonsoir tout le monde

:) :) On a eu la meme idée thierry, mais comme d'hab tu es toujours aussi rapide.

alors je met quand meme ma petite contribution, puisque le boulot est fait.

Sub Bouton5_QuandClic()
Dim maintenant As Variant
Dim tablo As Variant
Dim tablo2()
Dim x As Integer, i, j, k
maintenant = Timer


tablo = Range('a1:d' & Range('a65536').End(xlUp).Row)
'<=== à adapter

x = 1

For i = 1 To UBound(tablo)
&nbsp; &nbsp;
For j = 1 To 4
&nbsp; &nbsp; &nbsp; &nbsp;
If tablo(i, j) = 'x' Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
ReDim Preserve tablo2(1 To 4, 1 To x)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
For k = 1 To 4
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; tablo2(k, x) = tablo(i, k)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
Next k
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; x = x + 1
&nbsp; &nbsp; &nbsp; &nbsp;
End If
&nbsp; &nbsp;
Next j
Next i
Sheets('Feuil2').Range('a1').Resize(UBound(tablo2, 2), UBound(tablo2, 1)) = Application.Transpose(tablo2)
MsgBox Timer - maintenant

End Sub


salut
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Re:Supp ligne si cellule contient \"X\"

Bonsoir Hervé

Clap Clap Clap !!! Tu as été plus lent en Production, mais tu es le vainqueur en rapidité de traitement !!!


Y a pas Photo, Toute passer par Tableau (En Lecture de Plage Puis ensuite en Renvoie de Données avec le Resize et Transpose ! Et boum tu pulvérises les records !!!

D'ailleurs ton travail mérite sa place dans la démo V01 que ci-jointe...
Avec une Chti remarque sur ton code dans le fichier ;)

Merci à toi car j'arrive pas à me mettre ce resize / transpose dans la tête, pourtant Zon me l'a déjà montré !!!

Bonne Soirée
@+Thierry [file name=XLDTestBoucleTimerV01.zip size=14770]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/XLDTestBoucleTimerV01.zip[/file]

Message édité par: _Thierry, à: 08/06/2005 08:36
 

Pièces jointes

  • XLDTestBoucleTimerV01.zip
    14.4 KB · Affichages: 20

Hervé

XLDnaute Barbatruc
rebonsoir le fil
salut chti

Merci thierry,

Le coup du resize et transpose j'ai du le piquer à zon aussi :) ces pages wiki hantent mes nuits :) :)

Par contre pour les déclarations de variables du style : Dim x As Integer, i, j, k

si a la fin de la macro précédente, tu test par un vartype, du style MsgBox VarType(K) le code te renvoi bien un 2 donc un integer ????

Mais je sais pas si vartype renvoi le type déclaré par le dim ou le type adapté à la donnée ?

Merci de m'éclairer

Salut
 

ChTi160

XLDnaute Barbatruc
Re:Supp ligne si cellule contient \"X\"

Salut Hervé
bonsoir le fil
bon moi je ne suis pas un pro et j'ai testé ce que tu dit concernant la déclaration des Variables
j'ai donc dans la procèdure toute bête ci dessous ,déclaré
Sub test()
Dim I As Integer, K
I = Cells(1, 1).Value
K = Cells(2, 1).Value
MsgBox VarType(I)
MsgBox VarType(K)
End Sub

test si je mets deux integer dans A1 A2
VarType(I) donne 2
VarType(K) donne 8
si je mets en A1 un string(panthère) Lol Erreur
si je mets en A2 un String cela donne 8
donc j'en conclue que K n'est pas déclaré comme Integer
c'est ça dit moi
Merci d'avance

Message édité par: ChTi160, à: 07/06/2005 21:50
 

Hervé

XLDnaute Barbatruc
rebonsoir chti

je suis pas un pro non plus :)

Donc tes tests montrent comme je m'en doutais suite à l'intervention de thierry :) qu'il vaut mieux declarer toutes les variables.

Merci chti pour ces essais.

encore une chose d'apprise ce soir.

Salut
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Re:Supp ligne si cellule contient \"X\"

Bonsoir Hervé, Jean Marie

Vous savez les gars, j'aime bien rigoler, et ceux qui me connaissent en chair et en os, le savent, je suis pas un casse pied pour des détails, j'aime trop rigoler...

D'ailleurs pour vous le monter voici la preuve par Neuf !!! lol

Option Explicit
 
Sub TestPourMesCopainsHerveEtJeanMarie()
Dim Herve As Integer, JeanMarie
 
 
On Error Resume Next 'NB Juste pour les besoin de la démo ........
 
    Herve = 1
    JeanMarie = 1

MsgBox 'A ce stade Herve est ' & JeSuisKoi(Herve) & ' et JeanMarie est ' & JeSuisKoi(JeanMarie), , 'Test 1'

 
'plus tard... tatatata !!!!
    Herve = 'On tente une String'
    JeanMarie = 'Un Chti Sympa'

MsgBox 'Maintenant Herve est ' & JeSuisKoi(Herve) & ' et JeanMarie est ' & JeSuisKoi(JeanMarie), , 'Test 2'
 
 
'Encore plus tard... tatatata !!!!
    Herve = 255.55555
    JeanMarie = 255.55555

MsgBox 'Maintenant Herve est ' & JeSuisKoi(Herve) & ' et JeanMarie est ' & JeSuisKoi(JeanMarie), , 'Test 3'
 
 
'.... Toujours plus tard... tatatata !!!!
    Herve =
False
    JeanMarie =
True

MsgBox 'Maintenant Herve est ' & JeSuisKoi(Herve) & ' et JeanMarie est ' & JeSuisKoi(JeanMarie), , 'Test 3'


 
End Sub


Function JeSuisKoi(ByVal TheVariable As Variant) As String
   
Select Case VarType(TheVariable)
       
Case 0: JeSuisKoi = 'Empty (non initialisée)'
       
Case 1: JeSuisKoi = 'Null (aucune donnée valide)'
       
Case 2: JeSuisKoi = 'Integer (Entier)'
       
Case 3: JeSuisKoi = 'Long (Entier long)'
       
Case 4: JeSuisKoi = 'Simple (Nombre à virgule flottante en simple précision)'
       
Case 5: JeSuisKoi = 'Double (Nombre à virgule flottante en double précision)'
       
Case 6: JeSuisKoi = 'Currency (Valeur monétaire)'
       
Case 7: JeSuisKoi = 'Date (Valeur de date)'
       
Case 8: JeSuisKoi = 'String (Chaîne de caractères)'
       
Case 9: JeSuisKoi = 'Object (Objet)'
       
Case 10: JeSuisKoi = 'Error (Valeur d'erreur)'
       
Case 11: JeSuisKoi = 'Boolean (Valeur booléenne)'
       
Case Else: JeSuisKoi = 'Si vous voulez continuer.... lol'
   
End Select
End Function


Bonne Nuit
@+Thierry

Message édité par: _Thierry, à: 07/06/2005 23:26
 

Discussions similaires

Réponses
9
Affichages
902
Réponses
5
Affichages
430

Statistiques des forums

Discussions
312 415
Messages
2 088 235
Membres
103 776
dernier inscrit
Floortin