Supp ligne si cellule contient "X"

Pedro' · 7 Juin 2005

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

Pedro' · 7 Juin 2005

PLEASE HELP !!! !!

le Fnake · 7 Juin 2005

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 · 7 Juin 2005

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 · 7 Juin 2005

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 · 7 Juin 2005

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.

le Fnake · 7 Juin 2005

Un petit indice, regarde le nb de posts :
le Fnake : 10
@+Thierry : 935

A vous de devinez lequel des 2 est le champion ! :lol:

_Thierry · 7 Juin 2005

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]

Hervé · 7 Juin 2005

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)
    For j = 1 To 4
        If tablo(i, j) = 'x' Then
            ReDim Preserve tablo2(1 To 4, 1 To x)
                For k = 1 To 4
                    tablo2(k, x) = tablo(i, k)
                Next k
            x = x + 1
        End If
    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 · 7 Juin 2005

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

ChTi160 · 7 Juin 2005

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

Bonsoir le Fil
bonsoir le Forum
En Deux Mots 'C'est OUF'
bonne fin de Soirée
Merci encore

Message édité par: ChTi160, à: 07/06/2005 19:14

Hervé · 7 Juin 2005

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 · 7 Juin 2005

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é · 7 Juin 2005

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 · 7 Juin 2005

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

Supp ligne si cellule contient "X"

Pedro'

Guest

Pedro'

Guest

le Fnake

XLDnaute Junior

_Thierry

XLDnaute Barbatruc

le Fnake

XLDnaute Junior

STephane

XLDnaute Occasionnel

le Fnake

XLDnaute Junior

_Thierry

XLDnaute Barbatruc

Pièces jointes

Hervé

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

Pièces jointes

ChTi160

XLDnaute Barbatruc

Hervé

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Hervé

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

Discussions similaires