Macro qui voit si un élément d une liste est présent dans une autre liste

Version imprimable

06/03/2013, 15h50
bentor22

Macro qui voit si un élément d une liste est présent dans une autre liste

Bonjour à tous,

le titre n'est pas très explicite, je m'explique.

j'ai le début de ma macro et la fin pas le milieu.
A un moment de la macro, je veux faire la chose suivante:

Dans le workbooks(str).worksheets("am")
Colonne M
Ref 1
Ref 2
Ref 3
Ref 4

et dans thisworkbook.worksheets("feuil1")
Col A Col B Col C
A vendre A garder
Ref 1 Ref 1
Ref 2 Ref 2
Ref 3 Ref 3
Ref 4 Ref 4

Au cours su temps, manuellement, je change la position de Ref1 Ref2 ect...

le code que je ne sais pas faire est le suivant:

Si le contenu de la colonne M du workbooks(str).Worksheets("am") se trouve dans le thisworkbook.worksheets("feuil1") Colonne B
Then ...

Je vous remercie par avance pour votre aide,

bien cordialement
06/03/2013, 15h56
jfontaine

Bonjour,

Tu ne peux pas comparer directement les valeurs d'une plage de cellule avec les valeurs d'une autre plage de cellules.
Il te faut boucler sur chaque cellules d'une plage et pour chacune vérifier si elle est présente dans la seconde plage.
Reste a savoir ce que tu fais quand tu trouves (ou ne trouves pas) la valeurs !!

Bonjour,

Si je ne suis pas à coté de la plaque, un truc du genre

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub test()
 
Dim cpt_l As Integer
Dim valCellule As String
 
'parcours des lignes de le feuille am du classeur str
 
For cpt_l = 2 To Range("M" & Rows.Count).End(xlUp).Row
    valCellule = Workbooks(Str).Worksheets("am").Cells(cpt_l, 13)
 
    Set R = ThisWorkbook.Worksheets("feuil1").Range("B:B").Find(valCellule)
 
    If Not R Is Nothing Then
        'Le traitement si la valeur existe
    End If
 
Next cpt_l
 
 
End Sub

06/03/2013, 17h36
bentor22

Il me semble ne pas fonctionner, merci pour ton aide.

Jfontaine, pourrais tu je te prie me faire un exemple pour Ref1 afin que je m en inspire.

Je te remercie par avance pour ton aide

Je suis repartie de la proposition de goldstar en apportant ma touche perso;)

A noter que quand un code proposé ne semble pas fonctionner ou ne fait pas ce que tu attends, donnes nous l'erreur ou ce qui ne va pas :?

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 test()
 
Dim cpt_l As Long
Dim R As Range
Dim Sh1 As Worksheet
Dim Sh3 As Worksheet
 
Set Sh1 = Workbooks(Str).Worksheets("am")
Set sh2 = ThisWorkbook.Worksheets("feuil1")
 
'parcours des lignes de le feuille am du classeur str
For cpt_l = 2 To Sh1.Range("M" & Rows.Count).End(xlUp).Row
 
    Set R = sh2.Range("B:B").Find(what:=Sh1.Range("M" & cpt_i).Value, lookat:=xlWhole)
 
    If R Is Nothing Then
        'Le traitement si la valeur n'existe pas
    Else
        'Le traitement si la valeur existe
    End If
 
Next cpt_l
 
End Sub

Bonjour, merci pour votre réponse, je me suis aidé de votre code pour trouver la solution à mon problème, j'y ai ajouté quelques filtres supplémentaires.

Voici mon code:

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
Dim cpt_l As Long
Dim R As Range
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet
Dim ITU3 As Variant
Set clTravail = Workbooks(str).Worksheets("A M").Range("A:A")
 
Set Sh1 = Workbooks(str).Worksheets("Asset Management")
Set Sh2 = ThisWorkbook.Worksheets("feuil1")
Set Sh3 = ThisWorkbook.Worksheets("base")
ITU3 = Sh3.Range("J6").Offset(I, -9).Value
 
 
With ThisWorkbook.Worksheets("base")
For I = 0 To .Columns(5).Find("*", , , , xlByColumns, xlPrevious).Row - 1
   For Each Cell In clTravail
   If Cell.Value = ITU3 Then
      If Sh1.Range("L" & Cell.Row) = "Allocation" Then
         For cpt_l = 2 To Sh1.Range("M" & Rows.Count).End(xlUp).Row
            Set R = Sh2.Range("B:B").Find(what:=Sh1.Range("M" & cpt_i).Value, lookat:=xlWhole)
            If R Is Nothing Then
                   Sh3.Range("J6").Offset(I, 0) = 0
                Else
                   Sh3.Range("J6").Offset(I, 0) = WorksheetFunction.VLookup(ITU3, Workbooks(str).Worksheets("A M").Range("A2:P29701"), 16, False)
            End If
         Next cpt_l
      End If
   End If
   Next
Next
End With

je n'arrive pas à trouver la solution demandée, savez vous pourquoi svp?

07/03/2013, 13h43
bentor22

merci mais j ai reussi a faire executer la macro.

merci pour votre aide