Discussion :

[lilp1]

Bonjour, j'aimerais savoir si avec la méthode Find, on peut la faire avec deux criteres de recherche. Car j'aurrait besoin de copier des lignes en fonction de 2 criteres

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

Set a = .Range("A" & a.Row, "A" & dl).Find(nomjournal)

Sa c'est ma recherche sur un seul critere, mais j'aurrait besoin aussi de rechercher des valeurs 'date' dans la colonne 'b', j'avait penser a sa :

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

Set a = .Range("A" & a.Row, "A" & dl).Find(nomjournal) And .Range("B" & a.Row, "B" & dl).Find(date1)

Mais sa ne marche pas

[aalex_38]

Pourquoi 2 critères ?

Pourquoi pas chercher sur le premier critère et vérifier ensuite la valeur dans la colonne B selon la ligne trouvée ?

Sinon AUTOFILTER permet 2 critères.

[DeaD78]

Bonjour,

Pour ma part, quand j'ai eu besoin de faire cela (et supprimer des doublons etc.), j'ai imbriqué 2 boucles avec donc 2 .Find. Cela fonctionne très bien.

Bonne chance !

[Krovax]

La méthode Find renvoie un objet range dinc une cellule. Tu ne peux pas faire d'opération booléen sur une cellule. Ca n'a strictement aucun sens

Il va te faloir faire des boucle et imbriquer tout cas
Un exemple d'algorithme (en pseudo code) je te laisse le traduire en VBA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
tant que a exist
   a=Find(critère1)
   tan que b existe
      b=find(critère2)
      si a=b alors
         on quite les deux boucle a est la bonne valeur
      fin si
   fin tant que
fin tant que

Edit :

J'ai relu ton message. En fait j'ai rien compris a ce que tu veux faire.

essaye ca c'est peut être ce que tu souhaite

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set a = Union(.Range("A" & a.Row, "A" & dl).Find(nomjournal) ,.Range("B" & a.Row, "B" & dl).Find(date1))

[DeaD78]

Voilà, quand je disais imbriquer 2 boucles avec 2 .Find, c'est exactement l'algorithme de Krovax que j'utilise. Cela marche au poil !

Je te le mets si je le retrouve (traduit en VBA).

En gros, tu fais les 2 .Find imbriqués et si les 2 sont différents de Nothing alors tu peux copier ta ligne.

D'ailleurs, je me demande si je l'avais pas utilisé spécialement pour ce cas...

[lilp1]

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

Set a = Union(.Range("A" & a.Row, "A" & dl).Find(nomjournal) ,.Range("B" & a.Row, "B" & dl).Find(date1))

Ce code ne marche pas et pour le teste en 2 partie j'ai essayer de le coder, mais pas réussit lol.

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Do while a is not nothing
     Set a = .Range("A" & a.Row, "A" & dl).Find(nomjournal)
     Do while b is not nothing
       Set b = .Range("b" & a.Row, "b" & dl).Find(date1)
       if a = b then
           exit do
           exit do
       end if
     loop
loop

Voici mon code pour le moment avec une seule recherche, je verfie que date1 et date2 ne sont pas nul et je rentre dans ma boucle de recherche avec pour le moment qu'une seule condition de recherche :

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 If date1 <> "" Or date2 <> "" Then
        Set a = .Range("A" & a.Row, "A" & dl).Find(nomjournal)
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = "Ecriture"
        irow = 0
        irow2 = 1
        For x = 1 To dl - 1
            irow = irow + 1
            'Emepeche le rafraichissement de l'écran, pour ne pas voir le traitement
            Application.ScreenUpdating = False
            If a <> "" Then
                'création d'une nouvelle feuille et on l'a renomme
                firstaddress = a.Address
                'copie des lignes concerner
                Sheets("Ecriture").Cells(irow2, 1).Columns("A:BP").Value = a.EntireRow.Value
                irow2 = irow2 + 1
                Sheets("Ecriture").Select
            End If
            'Set a = .Range("A" & a.Row, "A" & dl).Find(nomjournal) And .Range("B" & a.Row, "B" & dl).Find(date1)
            Set a = .Range("B" & a.Row, "B" & dl).Find(date1)
        Next x

[DeaD78]

Bonjour,

Voilà ce que j'ai utilisé, c'est exactement ce que tu veux :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Dim FL1 As Worksheet
Dim Valeur As Variant, c As Range, Valeur2 As Variant, d As Range
Dim NoLigne As Long, DerLig As Long, NoLigne2 As Long, DerLig2 As Long
    Set FL1 = Worksheets("DATA2")
    NoLigne = 1
    Do
        If Not Cells(NoLigne, 4) = "" Then
            Valeur = Cells(NoLigne, 4)
            Valeur2 = Cells(NoLigne, 3)
            Do
                With FL1.Range("D" & NoLigne + 1, [D65536].End(xlUp))
                    DerLig = 0
                    Set c = .Find(Valeur, LookIn:=xlValues, LookAt:=xlWhole)
                    If Not c Is Nothing Then
                        If c.Row > NoLigne Then
 
                            With FL1.Range("C" & NoLigne + 1, [C65536].End(xlUp))
                            Set d = .Find(Valeur2, LookIn:=xlValues, LookAt:=xlWhole)
                            If Not d Is Nothing Then
 
                                DerLig = c.Row
                                c.EntireRow.Delete
 
                            End If
                            End With
                        End If
                    End If
                    Set c = Nothing
                End With
            Loop While DerLig > NoLigne
        End If
        NoLigne = NoLigne + 1
    Loop While NoLigne < FL1.Range("D65536").End(xlUp).Row

A la place de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

c.EntireRow.Delete

tu y fais ta copie et c'est bon. Adapte quand même mais il va te falloir comprendre un peu le code avant

Au plaisir !

[lilp1]

Dsl de faire le pelo chiant, mais y aurrait moyen que tu mettes kelkes commentaires, trop du mal a comprendre :s

[DeaD78]

Re,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Dim FL1 As Worksheet
Dim Valeur As Variant, c As Range, Valeur2 As Variant, d As Range
Dim NoLigne As Long, DerLig As Long, NoLigne2 As Long, DerLig2 As Long
    Set FL1 = Worksheets("DATA2") 'Tu travailles sur la feuille DATA2. Tu peux travailler sur 2 feuilles différentes si tu veux.
    NoLigne = 1 'Variable de ligne
    Do
        If Not Cells(NoLigne, 4) = "" Then
            Valeur = Cells(NoLigne, 4) 'Valeur recherchée en 1er : elle est en D1 puis D2, D3 etc...
            Valeur2 = Cells(NoLigne, 3) 'Valeur2 recherchée en 2eme : elle est en C1 puis C2...
            Do
                With FL1.Range("D" & NoLigne + 1, [D65536].End(xlUp)) 'Dans la colonne D jusqu'à la dernière cellule non vide
                    DerLig = 0 'Initialisation dernière ligne
                    Set c = .Find(Valeur, LookIn:=xlValues, LookAt:=xlWhole) 'Le .Find avec Valeur
                    If Not c Is Nothing Then 'Si valeur trouvée
                        If c.Row > NoLigne Then 'Si valeur trouvée autre que valeur de départ
 
                            With FL1.Range("C" & NoLigne + 1, [C65536].End(xlUp)) 'Dans la colonne C jusqu'à la dernière cellule non vide
                            Set d = .Find(Valeur2, LookIn:=xlValues, LookAt:=xlWhole) 'Le .Find avec Valeur2
                            If Not d Is Nothing Then 'Si valeur2 trouvée
 
                                DerLig = c.Row 'Dernière ligne devient celle de la valeur (la 1ère) trouvée
                                c.EntireRow.Delete 'Effacement de cette ligne
 
                            End If
                            End With
                        End If
                    End If
                    Set c = Nothing 'Et on recommence !
                End With
            Loop While DerLig > NoLigne 'Tant que Dernière Ligne > Ligne
        End If
        NoLigne = NoLigne + 1 'Incrémentation
    Loop While NoLigne < FL1.Range("D65536").End(xlUp).Row 'On continue jusqu'à la dernière ligne

Comme tu as pu le voir, le code s'occupe d'effacer les lignes où des doublons sont trouvés sur 2 critères. Tu as donc : recherche de la valeur de départ. Si le doublon est trouvé, recherche dans la colonne C de la valeur correspondante. Si c'est la même, on efface sinon, ce n'est pas un "vrai" doublon. Et on continue comme ça jusqu'à la fin de la feuille.

Il ne te reste plus qu'à adapter.

Bonne chance.

[lilp1]

Oki merci, jvais essayer de me demerder. Merci pour les comms