Recherche matricielle avec Macro VBA (Find?)

Version imprimable

22/05/2013, 12h36
Phakops92

1 pièce(s) jointe(s)

Recherche matricielle avec Macro VBA (Find?)

Bonjour à toute la communauté Excel!

Je suis utilisateur "très light" de VBA, et je parcours différents forums depuis quelques jours à la recherche d'indications pour construire une macro.

J'ai passé plus de temps que de raison chercher, sans réelle progression, je me tourne donc vers vous pour vous soumettre mon point.

Je cherche à construire un fichier dans lequel :
- J'ai un premier tableau avec des produits et des pièces qui composent chaque produit (produits en colonne, pièces en ligne, et une croix à l'intersection des deux pour indiquer quelle pièce compose chaque produit)
- J'ai un second tableau (autre onglet) avec pour chaque pièce, un prix
- Et j'ai un onglet dans lequel je souhaite indiquer le produit que je recherche.

==> Je souhaiterai construire une macro qui me renvoie, pour un produit que j'indique dans l'onglet de saisie, la liste des pièces qui le compose (en cherchant dans le premier tableau les pièces qui sont "cochées" pour le produit recherché), puis le prix de chaque pièce trouvée (en cherchant dans le second tableau contenant les pièces et leurs prix).

J'ai essayé des "VlookH", qui ne trouvent qu'une valeur fixe et unique, puis "Find", mais sans réussir à aboutir...

Je vous laisse un fichier en exemple (pièce jointe)

Si quelqu'un pourrait me venir en aide, ce serait bien-entendu super.

Phakops.

Edit : Excel 2010, je ne sais pas si le détail a de l'importance

Il faut que tu trouve la dernière colonne qui correspond à un composant. Ensuite tu cherche la ligne qui parle du produit que tu cherche, puis tu va récupérer tout les composants dont la case est cochée:
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 dim dernproduit as integer dim i as integer dim j as integer dim ligneproduit as integer dim produitrecherche as string sheets("Matrice").select 'Remplace Matrice par le nom de ton onglet dernproduit=1 while cells(1,dernproduit+1)<>"" dernproduit=dernproduit+1 wend ligneproduit=1 while cells(ligneproduit,1)<>produitrecherche ligneproduit=ligneproduit+1 wend j=1 for i=1 to dernproduit if cells(ligneproduit,i)="X" then cells(1,i).copy sheets("Listecomposant").select cells(j,1).select activesheet.paste j=j+1 sheets("Matrice").select end if next i
Voilà j'ai peut être inversé lignes et colonnes et je sais pas si tu attend le résultat sous cette forme (les composants listés dans la colonne A). Mais je pense que tu devrais pouvoir te dépatouiller avec ça.

Est-ce que l'exemple en PJ te convient?

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
Option Explicit
Option Base 1
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C, D As Range
Dim i As Integer
Dim strAddress As String
Dim strPiece As Variant
Dim strPieces(17) As String
 
    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$B$4" Then Exit Sub
 
    With Sheets("PRODUITS")
        Set C = .Rows(3).Find(Target.Value, , , xlWhole)
        Set D = .Columns(C.Column).Find("X", , , xlWhole)
        If D Is Nothing Then Exit Sub
 
        strAddress = D.Address
        Do
            strPieces(D.Row - 3) = .Cells(D.Row, 2)
            Set D = .Columns(C.Column).FindNext(D)
        Loop While D.Address <> strAddress
    End With
 
    i = 4
    With Sheets("SELECTION")
        .Range("D4:D20").ClearContents
        For Each strPiece In strPieces
            If strPiece <> "" Then
                .Cells(i, 4) = (strPiece)
                i = i + 1
            End If
        Next strPiece
    End With
 
End Sub

23/05/2013, 10h10
Phakops92

Bonjour à vous et merci pour vos réponses.

Je suis vraiment étonné par la rapidité de réponse et par la qualité du "support" que la communauté propose. C'est vraiment top.

Peut être par facilité, je me suis penché sur la réponse proposée directement dans le fichier Excel. Merci pour l'exercice.

C'est parfait à un détail prêt, qui n'est peut être pas le plus simple à mettre en oeuvre.

Votre Macro récupère bien la liste des PIECES pour chaque PRODUIT.

Ensuite, pour récupérer les PRIX de chaque PIECE, vous avez construit un Vlookup, car ma relation dans l'onglet "PRIX" entre les PIECES et les PRIX est de 1 pour 1. Mais en réalité, je peux avoir n PRIX pour 1 PIECE. Je souhaiterai donc que la macro récupère pour chaque PIECE, tous les différents prix qui la compose, et qu'elle affiche la liste de ces PRIX, pour toutes les PIECES précédemment trouvées. Le tableau de l'onglet "PRIX" ne présente pas, en l'état, de relation 1 à n mais seulement 1 à 1.

En synthèse :

1 PRODUIT => n PIECES => Liste à afficher (OK en l'état actuel de la macro)
n PIECES => n prix pour chaque PIECE => Liste à afficher (Le Vlookup actuel ne permet qu'une reltion 1 à 1).

Si quelqu'un pouvait m'éclairer sur cette seconde étape de Macro...en repartant de ce qui a été fait dans le fichier Excel de réponse, ce serait génial.

Encore merci à tous.
23/05/2013, 10h15
Invité

Si j'ai bien compris tu veux une liste déroulante dans la colonne prix des n prix appartenant à la pièce ?
23/05/2013, 10h41
Phakops92

Non. En fait dans l'onglet "SELECTION", je sélectionne un PRODUIT. Et la macro ramène la liste des PIECES qui composent le produit (en allant chercher dans l'onglet "PRODUIT", en fonction des croix, et cette partie est déja OK grâce à votre macro). Et toujours dans l'onglet "SELECTION", la macro ramène également la liste des PRIX de chaque PIECE trouvée précédemment.

Dans l'onglet "PRIX", il faut imaginer qu'une pièce peut avoir plusieurs prix, et que la macro devra afficher dans l'onglet "SELECTION", à la place du VLOOKUP, la liste des différents prix de toutes les pièces trouvées qui somposent le produit sélectionné dans la liste déroulante initiale.

Une seule sélection d'un seul produit dans la liste déroulante, et la macro ramène toutes les pièces et tous les prix de toutes les différentes pièces.

Je ne sais pas si je suis clair...
23/05/2013, 11h33
Invité

Ok dans ce cas adapte le fichier Excel existant comme tu l'entends et fais un exemple à la main. Je le coderai en VBA après.
23/05/2013, 12h10
Phakops92

1 pièce(s) jointe(s)

Voici un exemple commenté.

J'ai enregistré le fichier "sans macro" car je n'arrive pas à télécharger le format prenant en compte les macros. Je ne sais pas si votre code d'origine est conservé dans cette version.

Merci encore, c'est presque gênant, vraiment merci.

Phakops.

Un affichage en ligne des prix parait plus judicieux. Est-ce que tu es d'accord?

Un exemple est en PJ.

!!! L'ensemble est codé en dur ; c'est à dire que si tu ajoutes une colonne (par exemple) le programme ne fonctionnera plus (ou mal).

Le code mis à ta disposition est donc une aide qu'il faut que tu t'appropries pour ensuite être capable de le modifier à ta guise.

Si tu as des questions n'hésite 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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Option Explicit
Option Base 1
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C, D, E As Range
Dim i, j As Integer
Dim strAddress As String
Dim strPiece, strPrix As Variant
Dim strPieces(17), strPrixs() As String
 
    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$B$4" Then Exit Sub
 
    Application.ScreenUpdating = False
 
    With Sheets("PRODUITS")
        Set C = .Rows(3).Find(Target.Value, , , xlWhole)
        Set D = .Columns(C.Column).Find("X", , , xlWhole)
        If D Is Nothing Then Exit Sub
 
        strAddress = D.Address
        Do
            strPieces(D.Row - 3) = .Cells(D.Row, 2)
            Set D = .Columns(C.Column).FindNext(D)
        Loop While D.Address <> strAddress
    End With
 
    i = 4
    With Sheets("SELECTION")
        'Effacement des cellules
        .Range("D4:O20").ClearContents
        For Each strPiece In strPieces
            If strPiece <> "" Then
                'Affichage des pièces
                .Cells(i, 4) = (strPiece)
                i = i + 1
                'Affichage des prix
                ReDim strPrixs(100)
                With Sheets("PRIX")
                    Set C = .Columns(2).Find(strPiece, , , xlWhole)
                    If C Is Nothing Then Exit Sub
                    strAddress = C.Address
                    Do
                        strPrixs(C.Row - 3) = .Cells(C.Row, 3)
                        Set C = .Columns(2).FindNext(C)
                    Loop While C.Address <> strAddress
                End With
                j = 6
                For Each strPrix In strPrixs
                    If strPrix <> "" Then
                        .Cells(i - 1, j) = strPrix
                        j = j + 1
                    End If
                Next
 
            End If
        Next strPiece
    End With
 
End Sub

23/05/2013, 15h43
Phakops92

Je n'ai pas grand chose à dire à part un grand merci! C'est vraiment ce que je souhaitais.

Je pense être capable de comprendre ce que tu as fait, et capable d'adapter le code à mon fichier cible.

En cas de problème je n'hésiterai pas, mais c'est vraiment très sympa.

Merci mille fois pour l'aide, c'est vraiment très précieux. Au plaisir de pouvoir payer un coup en remerciements!

Phakops.