Recherche VBA avec condition

Version imprimable

Bonjour,

est il possible d'adapter le code ci-dessous, je m'explique.
Je voudrais faire des recherches qui me renvoie le informations sur une autre feuille Excel.

La condition est simple s'il trouve la valeur dans la colonne A et la colonne D sur la même ligne de me renvoyer les informations vers une autre feuille.

Actuellement j'ai ça comme code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub Vérif_pl() Dim cell As Range For Each cell In Sheets("déploiement").Range("c1:c" & Sheets("déploiement").Range("c65000").End(xlUp).Row) 'Recherche avec Ma dans l'inventaire' Set c = Sheets("Extract_Full_DCOL_EUR_FR_201303").Range("k:k").Find(cell, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then 'Renvoi le modele ' Sheets("déploiement").Cells(cell.Row, 19) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 13) 'Renvoi le Type' Sheets("déploiement").Cells(cell.Row, 13) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 12) 'Renvoi la configuration' Sheets("déploiement").Cells(cell.Row, 12) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 25) End If Next cell
En faite il faudrait adapter le début mais je ne sais pas comment faire.
Si vous avez des pistes je suis preneur.

Merci

12/06/2013, 21h57
parmi

Bonjour,

Si tu as plusieurs critères à vérifier, j'ajouterais une colonne qui contiendrait la concaténation des valeurs recherchées.

Donc, dans ton cas, tu ajoutes une colonne dans laquelle tu inscris la formule
=A1 & D1
que tu copies dans toutes la colonne et tu fais ta recherche dans cette colonne.

Et tu répètes la même procédure dans l'autre feuille en mettant la formule nécessaire
12/06/2013, 22h17
Leodams

Merci pour ton idée Parmi, mais je ne peux pas car la feuille ou ce trouve les informations change tous les jours.

Alors je pensais que si je pouvais effectuer une recherche à condition que les deux valeurs soient sur la même ligne.
il me renvoie les cellules de la même Row vers mon reporting

Bonsoir,

Citation:

Envoyé par Leodams

La condition est simple s'il trouve la valeur dans la colonne A et la colonne D sur la même ligne de me renvoyer les informations vers une autre feuille.

Le code suivant effectue la copie de :
3 cellules d'une même ligne de la feuille Extract_Full_DCOL_EUR_FR_201303
vers 3 cellules la même ligne sur la feuille déploiement .
Cette copie s'effectue lorsque sur une même ligne de la feuille Extract_Full_DCOL_EUR_FR_201303, la colonne C et D ont la même valeur.

Code:

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
Option Explicit
 
Sub Vérif_pl()
    Dim wsSrc As Worksheet
    Dim wsDest As Worksheet
    Set wsSrc = Sheets("Extract_Full_DCOL_EUR_FR_201303")
    Set wsDest = Sheets("déploiement")
 
    Dim LastLine As Long
    LastLine = wsDest.Range("c" & Rows.Count).End(xlUp).Row
 
    Dim Col_C As Variant
    Dim Col_D As Variant
    Col_C = wsSrc.Range("c1:c" & LastLine)
    Col_D = wsSrc.Range("d1:d" & LastLine)
 
    Dim li As Long
    For li = 1 To UBound(Col_C, 1)
        If Col_C(li, 1) = Col_D(li, 1) Then
            With wsSrc
                wsDest.Cells(li, 19) = .Cells(li, 13) 'Renvoi le modele '
                wsDest.Cells(li, 13) = .Cells(li, 12) 'Renvoi le Type'
                wsDest.Cells(li, 12) = .Cells(li, 25) 'Renvoi la configuration'
            End With
        End If
    Next li
End Sub

14/06/2013, 00h40
Leodams

1 pièce(s) jointe(s)

Merci pour ta réponse mais je crois que je me suis mal fait comprendre.
Dans la feuille que j'ai mis en ligne un exemple de ce que je souhaiterais mettre en place.

Je dois rechercher dans la feuille "deploiement" les valeurs des colonnes C et I
Dans la feuille Exctract_FULL_ DCOL en colonne K et N

Si la recherche des deux valeurs dans "deploiement" sont trouvées dans Extract_Full_DCOL sur la même ligne alors renvoyer les valeurs de la colonne L vers la feuille "deploiement" dans la cellule D2 ainsi de suite....

Le code que j'ai mis en premier à la même démarche sauf qu'il recherche que seul valeur.

Merci de votre aide.
@+

Bonjour,

Mon interprétation est que tu veux copier des cellules de la feuille Extract_FULL_DCOL vers la feuille Deploiement lorsque
sur une même ligne sur ces 2 feuilles la condition suivante est remplie :
Deploiement!(C<ligne>) = Extract_FULL_DCOL!(K<ligne>)et Deploiement!(I<ligne>) = Extract_FULL_DCOL!(N<ligne>).

Le code fait ce qui est décrit ci-dessus.
Code:

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 Option Explicit Sub Vérif_pl() Dim wsSrc As Worksheet Dim wsDest As Worksheet Set wsSrc = Sheets("Extract_FULL_DCOL") Set wsDest = Sheets("Deploiement") Dim LastLine As Long LastLine = wsDest.Range("c" & Rows.Count).End(xlUp).Row Dim srcCol1 As Variant Dim srcCol2 As Variant Dim dstCol1 As Variant Dim dstCol2 As Variant srcCol1 = wsSrc.Range("K1:K" & LastLine) srcCol2 = wsSrc.Range("N1:N" & LastLine) dstCol1 = wsDest.Range("C1:C" & LastLine) dstCol2 = wsDest.Range("I1:I" & LastLine) Dim li As Long For li = 1 To UBound(dstCol1, 1) If (srcCol1(li, 1) = dstCol1(li, 1)) And (srcCol2(li, 1) = dstCol2(li, 1)) Then With wsSrc wsDest.Cells(li, "D") = .Cells(li, "L") End With End If Next li End Sub
P.S. :

Citation:

je crois que je me suis mal fait comprendre.

En effet, et c'est rien de le dire. :cry:
Il n'y pas de rapport entre :
- ce que tu écris dans la description de ce que tu veux faire dans les différents post.
- entre la description de ce que tu veux faire et le code posté
(la description parle de renvoyer des valeurs en Colonne D, mais le code posté n'y écrit jamais)
- entre la description de ce que tu veux faire et le fichier exemple.
(dans le fichier posté, il n'y aucun cas où sur la même ligne on a à la fois :
Code:

1 2 3 Deploiement!(C) = Extract_FULL_DCOL!(K) 'et Deploiement!(I) = Extract_FULL_DCOL!(N)
)

Donc c'est très difficile de t'aider dans ces conditions. Pour obtenir de l'aide sur le forum, je te conseille vivement :
- de poster un code qui corresponde à la discription de ton post.
- d'être plus clair/précis dans tes descriptions

Bonjour,

Ok merci pour la modif mais il est vrai que le code de départ n'été pas bon.
voici le code utilisé :

Code:

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
Sub Vérif_statusHP()
 
Dim cell As Range
 
For Each cell In Sheets("Déploiement").Range("c1:c" & Sheets("Déploiement").Range("c65000").End(xlUp).Row)
 
Set c = Sheets("Status Report").Range("g:g").Find(cell, LookIn:=xlValues, LookAt:=xlWhole)
 If Not c Is Nothing Then
 'renvoi le status de la migration'
 Sheets("Déploiement").Cells(cell.Row, 33) = Sheets("Status Report").Cells(c.Row, 3)
 'renvoi la vague '
 Sheets("Déploiement").Cells(cell.Row, 40) = Sheets("Status Report").Cells(c.Row, 43)
 'renvoi commentaire
Sheets("Déploiement").Cells(cell.Row, 22) = Sheets("Status Report").Cells(c.Row, 68)
'renvoi la date du changement
Sheets("Déploiement").Cells(cell.Row, 17) = Sheets("Status Report").Cells(c.Row, 66)
'renvoi le New Model PC
Sheets("Déploiement").Cells(cell.Row, 27) = Sheets("Status Report").Cells(c.Row, 49)
'renvoi Action type HP
Sheets("Déploiement").Cells(cell.Row, 35) = Sheets("Status Report").Cells(c.Row, 48)
End If
Next cell 
 
 
 
 
End Sub

Je souhaiterais modifier la recherche:

Déploiement colonnes "C"= Status report colonne "G" et déploiement colonne "j"= status report "AA"

si les valeurs trouvées sont sur la même ligne renvoyer les valeurs des cellules indiquez dans le code.

Bonsoir,

Essaye le code suivant :

Code:

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
34
35
36
37
38
39
Option Explicit
 
Sub Vérif_pl()
    Dim wsSrc As Worksheet
    Dim wsDest As Worksheet
    Set wsSrc = Sheets("Status Report")
    Set wsDest = Sheets("Deploiement")
 
    Dim LastLine As Long
    Dim dstCol1 As Variant
    Dim dstCol2 As Variant
    LastLine = wsDest.Range("c" & Rows.Count).End(xlUp).Row
    dstCol1 = wsDest.Range("C1:C" & LastLine)
    dstCol2 = wsDest.Range("J1:J" & LastLine)
    Dim srcCol1 As Variant
    Dim srcCol2 As Variant
    LastLine = wsSrc.Range("G" & Rows.Count).End(xlUp).Row
    srcCol1 = wsSrc.Range("G1:G" & LastLine)
    srcCol2 = wsSrc.Range("AA1:AA" & LastLine)
 
 
    Dim lisrc As Long
    Dim lidst As Long
    For lidst = 1 To UBound(dstCol1, 1)
        For lisrc = 1 To UBound(srcCol1, 1)
            If (srcCol1(lisrc, 1) = dstCol1(lidst, 1)) And (srcCol2(lisrc, 1) = dstCol2(lidst, 1)) Then
                With wsSrc
                    wsDest.Cells(lidst, 33) = .Cells(lisrc, 3) 'renvoi le status de la migration'
                    wsDest.Cells(lidst, 40) = .Cells(lisrc, 43) 'renvoi la vague '
                    wsDest.Cells(lidst, 22) = .Cells(lisrc, 68) 'renvoi commentaire
                    wsDest.Cells(lidst, 17) = .Cells(lisrc, 66) 'renvoi la date du changement
                    wsDest.Cells(lidst, 27) = .Cells(lisrc, 49) 'renvoi le New Model PC
                    wsDest.Cells(lidst, 35) = .Cells(lisrc, 48) 'renvoi Action type HP
                End With
                Exit For
            End If
        Next lisrc
    Next lidst
End Sub

17/06/2013, 21h23
Leodams

Ah je crois qu'on tient le bon bout :ccool:

Merci de ta patience, je vais faire quelque test et je tiens au courant.

A vrai dire, je ne comprends pas tout le code que tu as développé.....
Mais j'apprends...!
Pourquoi utiliser ces foncions plutôt qu'une autre. Moi je l'ai fait avec la fonction FIND et toi avec des simples variables .....?

Enfin ce qui est important, c'est que les deux variables soient sur la même ligne pour m'envoyer les informations.

Merci.

@

Re.

Citation:

Envoyé par Leodams

Pourquoi utiliser ces foncions plutôt qu'une autre. Moi je l'ai fait avec la fonction FIND et toi avec des simples variables .....?

Il est souvent possible de faire différemment les même choses.
Ce qui les distingue c'est la simplicité du code, et la performance à l'exécution.
Notamment l'utilisation de tableau permet des gains de performance.

Mais si tu as peu de donnée, et si tu souhaites continuer à utiliser la fonction Find et d'accéder aux cellules avec les fonctions Cells et Range, tu peux partir de la fonction suivante :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Vérif_statusHP()
    Dim cell As Range
    Dim wsSrc As Worksheet
    Dim wsDest As Worksheet
    Set wsSrc = Worksheets("Status Report")
    Set wsDest = Worksheets("Déploiement")
 
    For Each cell In wsDest.Range("c1:c" & wsDest.Range("c" & Rows.Count).End(xlUp).Row)
        Set c = wsSrc.Range("g:g").Find(cell, LookIn:=xlValues, LookAt:=xlWhole)
 
        If Not c Is Nothing Then
              If wsDest.Range("J" & cell.Row) = wsSrc.Range("AA" & c.Row) Then
                With wsDest
                    .Cells(cell.Row, 33) = wsSrc.Cells(c.Row, 3)  'renvoi le status de la migration
                    .Cells(cell.Row, 40) = wsSrc.Cells(c.Row, 43) 'renvoi la vague
                    .Cells(cell.Row, 22) = wsSrc.Cells(c.Row, 68) 'renvoi commentaire
                    .Cells(cell.Row, 17) = wsSrc.Cells(c.Row, 66) 'renvoi la date du changement
                    .Cells(cell.Row, 27) = wsSrc.Cells(c.Row, 49) 'renvoi le New Model PC
                    .Cells(cell.Row, 35) = wsSrc.Cells(c.Row, 48) 'renvoi Action type HP
                End With
            End If
        End If
    Next cell
End Sub

A+

20/06/2013, 12h40
Leodams

MERCI ça fonctionne !:ccool:

@+