Discussion :

[bb2008]

Jai un probleme jai les tableaux suivant

produit

a3
a6
a20
...

sur un autre tableau

produit composant

a1 sdflk0
a1 qweqw0
a1 451510
a1 151550
a2 151510
a3 151055
a3 151212
...

Le but etant de trouver les composants associes au produit dans le deuxieme tableaux et de recuperer ces valeurs dans une autre feuille ou fichier


je peux pas effectuer la fonction Vloockup
car il me retourne pour a3 par exemple le premier composant et apres passe a a6

les tableaux sont sur fichiers differants

Comment faire ?
jai pense a creer un script vba avec une boucle mais mes connaissances sont nul et jarrive a rien
Merci pour votre aide.

[ouskel'n'or]

Utilise une boucle avec Find, tu as un excellent exemple dans l'aide en ligne avec très peu de choses à modifier.

Le but etant de trouver les composants associes au produit dans le deuxieme tableaux et de recuperer ces valeurs dans une autre feuille ou fichier

Et une fois trouvés, tu en fais quoi, des composants ?
A+

[bb2008]

Le mieu serait de pouvoir afficher ces composants dans une colonne a cote du premier tableau.
Je vais aller voir la fonction Find. Merci a toi

[ouskel'n'or]

Ok.
Je suppose a1 en colonne A et qweqw0 en colonne B dans les deux feuilles
feuil1 contient a1
feuil2 contient a1 et qweqw0
Je parcours feuil1 et lis chaque cellule de la colonne A
Pour chaque cellule, je cherche l'équivalent dans feuille 2 colonne A
Pour chaque donnée trouvée ds feuil2, je place dans la colonne B de feuil1 ce qui se trouve dans feuil2 colonne B.
Une fois corrigé

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
Sub Test()
Dim FL1 As Worksheet, FL2 As Worksheet, Cell As Range, c as range
    Set FL1 = Worksheets("feuil1")
    Set FL2 = Worksheets("feuil2")
    For Each Cell In FL1.Range("a1:a" & Cells(Columns(NoCol).Cells.Count, NoCol).End(xlUp).Row)
        With FL2.Range("a1:a" & FL2.Range("a1:a" & Cells(Columns(NoCol).Cells.Count, NoCol).End(xlUp).Row))
            Set c = .Find(Cell, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    Cell.Offset(0, 1) = c.Offset(0, 1)
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    Next
End Sub

Si tu veux d'autres explications...
A+

[bb2008]

Tout est dans le titre mais sincerement merci pour ton aide !!!! -_-

[ouskel'n'or]

Sauf que je t'ai mis une bêtise, remplace "partout" Offset(0,2) par Offset(0,1)

[bb2008]

jvai faire ca

[ouskel'n'or]

Ça ne fonctionne pas : Pour chaque a1, si tu n'en as qu'un seul en feuil1 et plusieurs en feuil2, le code que je t'ai passé écrira la dernière valeur de la colonne B de feuil2, cette dernière valeur écrasant les précédentes.
Par contre, pour traiter ça, je manque de précision :
Veux-tu obtenir toutes les valeurs correspondant à a1 ou seulement l'une d'elles ?
Veux-tu toutes les valeurs sur les colonnes suivantes ou une seule valeur par a1 dans la colonne B de feuil1 ? (donc insérer des lignes ?)
Je n'avais pas vu toutes les implications
Tu dis
A+

[bb2008]

il me faut toute les valeurs B pour chaque a1
item
a1 adkal;
a1 adad
a1 adasda

[bb2008]

donc oui je suppose qui faut rajoute des lignes ou des colonnes:
comme par exemple

A1 B1 B2 B3

item1 dsfdsf ADSA SDA

autre question worksheet c un fichier exel ou une feuille d un fichier ?

[ouskel'n'or]

worksheet est une feuille
workbook le classeur
Le mieux est d'insérer une ligne pour chaque "nouvelle" correspondance.
Une dernière question : Peux-tu, au départ, avoir, dans feuil1, plusieurs items identiques ?

a1
a1
a1
a3
a3
...

[bb2008]

dans la feuille ou ya les composant

oui il y a des doublons

a1 b1
a1 b2
a1 b3
a2 b4
a2 b5


dans la feuilles ou ya juste les les a = il ny a pas de doublons

a1
a2
a3
a4
a5

[ouskel'n'or]

Je te propose ça, pas testé, donc sans filet

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
Sub Test()
Dim FL1 As Worksheet, FL2 As Worksheet, Cell As Range, c As Range
Dim NoLig As Long, Cpteur As Integer
    Set FL1 = Worksheets("feuil1")
    Set FL2 = Worksheets("feuil2")
    NoLig = 2
    Do
        Set Cell = FL1.Cells(NoLig, 1)
        With FL2.Range("a1:a" & FL2.Range("a1:a" & Cells(Columns(1).Cells.Count, 1).End(xlUp).Row))
            Set c = .Find(Cell, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    If Cpteur > 0 Then
                        'insert une ligne si plusieurs items identiques
                        Cell.EntireRow.Insert shift:=xlShiftDown
                    End Sub
                    Cell.Offset(Cpteur, 0) = c 'copie la 1ère colonne
                    Cell.Offset(Cpteur, 1) = c.Offset(0, 1) '... la seconde
                    Set c = .FindNext(c)
                    Cpteur = Cpteur + 1
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
        NoLig = Cell.row + Cpteur
        Cpteur = 0
    Loop While NoLig <= FL1.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
End Sub

Inconvénient de la méthode : Si tu as plusieurs items identiques dans feuil2, la copie les placera dans l'ordre inverse dans feuil1.
Peux-tu tester pour moi ?
A+

[bb2008]

jvai teste =)
merci

[bb2008]

il me met une compile error

block if without end if

[ouskel'n'or]

Tu pourrais trouver tout seul, remplace End sub par Endif ici

Code :

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

1
2
                        Cell.EntireRow.Insert shift:=xlShiftDown
                    Endif