Recherche VBA avec condition

**Leodams** · 12/06/2013, 21h24

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 :

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
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

**parmi** · 12/06/2013, 21h57

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

**Leodams** · 12/06/2013, 22h17

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

**BlueMonkey** · 12/06/2013, 23h48

Bonsoir,

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 :

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
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

**Leodams** · 14/06/2013, 00h40

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.
@+

**BlueMonkey** · 14/06/2013, 07h20

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 :

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
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. :

je crois que je me suis mal fait comprendre.

En effet, et c'est rien de le dire.

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 :

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

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

**Leodams** · 17/06/2013, 16h50

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 :

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
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.

**BlueMonkey** · 17/06/2013, 20h41

Bonsoir,

Essaye le code suivant :

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
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

Recherche VBA avec condition [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager