Moteur d'affectation (recherche intelligente)

Bonjour à tous,

Je travaille actuellement sur un moteur d'affectations inversées (tels produits compatibles avec X véhicule, ainsi tous mes clients qui ont le véhicule X retrouveront le produit compatible), un peu similaire à ce qu'on peut trouver sur des sites de pièces détachées par exemple.

Voici un fichier sur lequel je travaille en PJ avec le résultat suivant que je souhaite obtenir :

• Dans ma colonne B sur la Table 1, je souhaite répertorier tous les véhicules compatibles avec la référence (clé) située dans la colonne A.

• Les données se trouvent ici dans la Table 2. Il y a tout d'abord une zone de recherche et surtout plusieurs résultats possibles.

=> Ainsi le produit 886195 est compatible avec "Citroën Berlingo, Citroën Saxo, Citroën Xsara Picasso, Peugeot 406, Peugeot Partner"

Auriez-vous une solution pour automatiser cette tâche ?

Je vous remercie infiniment !

Salut,

J'ai testé un truc avec mise à jour auto de la table 1 via macro dans VBA.

Mon code est perfectible car j'ai laissé le chiffre 6 en brut dans le code. (donc si tu as plus de 6 colonnes dans la table 2 il faudra modifier

Girodo,

Bonjour Louis92, Girodo

Voyez si le fichier joint peut vous aider

Un problème subsiste, où trouver le libellé de la pièce, on a sa référence mais pas son nom...

Vous êtes spécialisé dans les "Coque 2 boutons compatible"

Salut njhub

Tu est un sauvage xD !

S'il te dis que là ce n'est qu'un fichier exemple et qu'en réalité il y a 50 colonnes en Tab 2 tu es mal :p

Girodo,

@ Girodo

Tu est un sauvage xD !

pour le reste j'attends la réponse de Louis92, on improvisera en temps utile

Girodo a écrit :

Salut,

J'ai testé un truc avec mise à jour auto de la table 1 via macro dans VBA.

Mon code est perfectible car j'ai laissé le chiffre 6 en brut dans le code. (donc si tu as plus de 6 colonnes dans la table 2 il faudra modifier

Girodo,

Bonjour Girodo et merci pour ta réponse.

Cependant, je n'arrive pas à la lancer sur mon Excel (2010). J'ai une erreur d'exécution 1004.

Quand j'essaye de la réécrire manuellement, les résultats ne sont pas corrects ou sont incomplets.

Une macro me semble toutefois une solution moins complexe qu'une interminable formule ...

Désolé si c'est bête, je suis un néophyte dans ce vaste monde de la macro

Girodo a écrit :

Salut njhub

Tu est un sauvage xD !

S'il te dis que là ce n'est qu'un fichier exemple et qu'en réalité il y a 50 colonnes en Tab 2 tu es mal :p

Girodo,

C'est un peu l'idée

Bonjour Girodo

ta macro dur dur sur exclel 2002

modification pour etre compatible

Private Sub Worksheet_Activate()
'
'''For lT1 = 2 To Sheets("Table 1").Range("A1048576").End(xlUp).Row
Application.ScreenUpdating = False
    For lT1 = 2 To Range("A" & Rows.Count).End(xlUp).Row
        'RAZ "Compatible"
        Cells(lT1, 3) = ""
    'Ajout des V?hicules compatibles en Colonne C
'    ' ''   For lT2 = 1 To Sheets("Table 1").Range("A1048576").End(xlUp).Row
        For lT2 = 1 To Range("A" & Rows.Count).End(xlUp).Row
            For cT2 = 2 To 6
                If Sheets("Table 2").Cells(lT2, cT2) = Cells(lT1, 1) Then
                    Cells(lT1, 3) = Cells(lT1, 3) & ", " & Sheets("Table 2").Cells(lT2, 1)
                End If
            Next
        Next
        'Suppression du " ," au d?but
        Cells(lT1, 3) = Mid(Sheets("Table 1").Cells(lT1, 3), 3)
    Next
End Sub

A+

Maurice

Bonjour,

Une piste !

Code à mettre dans le module de la feuille "Table 1" et pour tester, inscrire une référence de pièce dans la colonne A :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Plage As Range
    Dim Cel As Range
    Dim Adr As String
    Dim Chaine As String

    If Target.Count > 1 Then Exit Sub
    If Target.Column > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub

    Set Plage = DefPlage(Worksheets("Table 2"))

    Set Cel = Plage.Find(Target.Value, , xlValues, xlWhole)

    If Not Cel Is Nothing Then

        Adr = Cel.Address

        Do
            Chaine = Chaine & Plage(Cel.Row, 1).Value & ", "

            Set Cel = Plage.FindNext(Cel)

        Loop While Cel.Address <> Adr

        Chaine = Left(Chaine, Len(Chaine) - 2)

        Application.EnableEvents = False

        Target.Offset(, 1).Value = Chaine

    Else

        Target.Offset(, 1).Value = ""

    End If

    Application.EnableEvents = True

End Sub

Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range

    On Error GoTo Fin

    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With

    Exit Function

Fin:

    Set DefPlage = Nothing

End Function

archer a écrit :

Bonjour Girodo

ta macro dur dur sur exclel 2002

modification pour etre compatible

Private Sub Worksheet_Activate()
'
'''For lT1 = 2 To Sheets("Table 1").Range("A1048576").End(xlUp).Row
Application.ScreenUpdating = False
    For lT1 = 2 To Range("A" & Rows.Count).End(xlUp).Row
        'RAZ "Compatible"
        Cells(lT1, 3) = ""
    'Ajout des V?hicules compatibles en Colonne C
'    ' ''   For lT2 = 1 To Sheets("Table 1").Range("A1048576").End(xlUp).Row
        For lT2 = 1 To Range("A" & Rows.Count).End(xlUp).Row
            For cT2 = 2 To 6
                If Sheets("Table 2").Cells(lT2, cT2) = Cells(lT1, 1) Then
                    Cells(lT1, 3) = Cells(lT1, 3) & ", " & Sheets("Table 2").Cells(lT2, 1)
                End If
            Next
        Next
        'Suppression du " ," au d?but
        Cells(lT1, 3) = Mid(Sheets("Table 1").Cells(lT1, 3), 3)
    Next
End Sub

A+

Maurice

Merci Maurice, ça fonctionne déjà mieux

Cependant, lorsque je lance la macro, je n'obtiens pas tous les résultats possibles.

En l’occurrence, au lieu d'obtenir 5 résultats sur la première référence, je n'en obtiens qu'un seul.

La deuxième, quant à elle, ne trouve que 4 résultats possibles sur 8.

De plus, c'est un fichier exemple. Ou puis-je intervenir dans la macro pour que je puisse rajouter des références dans la colonne A de la Table 1 (actuellement il ne prend en compte que les 3 premières références) et surtout une base de données plus importante dans la Table 2 ?

C'est dommage je vous assure que chez moi la version que j'ai posté fonctionnait très bien

Tu es bien sous excel 2010 ?

Je regarde

Edit : J'ai trouvé une coquille dans mon code : Essaie ça !

Girodo,

Girodo a écrit :

C'est dommage je vous assure que chez moi la version que j'ai posté fonctionnait très bien

Tu es bien sous excel 2010 ?

Je regarde

Girodo,

Je le jure !

As-tu pu testé le correctif posté dans mon précédent message ?

Girodo,

Girodo a écrit :

As-tu pu testé le correctif posté dans mon précédent message ?

Girodo,

Oui, à l'instant !!

C'est parfait parfait parfait !!

Merci infiniment

Bonjour

encore une rectife a faire

A voir

Private Sub Worksheet_Activate()
'
'Debug.Print "d?but"
Application.ScreenUpdating = False
    For lT1 = 2 To Range("A" & Rows.Count).End(xlUp).Row
        'RAZ "Compatible"
        Cells(lT1, 3) = ""
        'Ajout des V?hicules compatibles en Colonne C
        For lT2 = 1 To Feuil2.Range("A" & Rows.Count).End(xlUp).Row
            For cT2 = 2 To 6
                If Feuil2.Cells(lT2, cT2) = Cells(lT1, 1) Then
                    Cells(lT1, 3) = Cells(lT1, 3) & ", " & Feuil2.Cells(lT2, 1)
                End If
            Next
        Next
        'Suppression du " ," au d?but
        Cells(lT1, 3) = Mid(Cells(lT1, 3), 3)
    Next
End Sub

amuse toi bien

A+

Maurice

Merci à tous !