Trouver les produits similaires pour chaque référence

Bonjour à tous,

J'aimerais trouver les produits similaires pour chaque référence, concrètement, on récupère les 6 derniers produits de la même catégorie, en remplissant les cellules de la colonne "produit_similaire" dan la feuille "source" à partir des informations de la feuille "DB_produit".
La feuille "resultat", c'est le résultat souhaité.

Exemple:
Pour le pantalon PANT1, il récupère les 6 derniers produits de la même catégorie (pantalons) dans la feuille "DB_produit", les 6 produits combinés sont séparés par le virgule, et on les met dans les champs 1 à 6, les produits sont classés par ID Produit, on prends les 6 derniers ID Produit. A noter que comme la référence PANT1 existe déjà elle même, il ne faut pas l'ajouter parmi les produits similaires, du coup, on a que 5 références combinées pour cette référence.

Voici le résultat des produits similaire pour la référence PANT1
PANT5,PANT6,PANT-TOTO,PANT-TATA,PANT-LOLO,

Merci en avance pour votre aide.

Hello,

Une proposition :

Affichage - Macro - Exécuter

Bonjour Rag02700,

Merci bcps, ça marche impeccablement.
Je vais essayer digérer ce code en vbs pour adapter à mon fichier réel.

Bonne journée !

Voici le code commenté

Sub TrouveProduit()

    Dim wksProduct As Worksheet, wksSource As Worksheet
    Dim i&, lngLastRow&, x&, j&
    Dim strCat$, strRef$, stProductSim$, strAddress$
    Dim rngCat As Range
    Dim varArrTmp As Variant

    Set wksSource = Worksheets("source") ' feuille source
    Set wksProduct = Worksheets("DB_produit") ' feuille produit
    'Tri le tableau de la feuille produit
    wksProduct.[A1].CurrentRegion.Sort Key1:=wksProduct.[A1], Order1:=xlDescending, Header:=xlYes
    lngLastRow& = wksSource.Cells(wksSource.Rows.Count, 1).End(xlUp).Row 'Derniere ligne de la colonne 1 de la feuille source
    For i = 2 To lngLastRow&
        strRef$ = wksSource.Range("A" & i) 'Recup référence de chaque ligne de la colonne A de la feuille source
        strCat$ = wksSource.Range("B" & i) 'Recup Categorie de chaque ligne de la colonne B de la feuille source
        Set rngCat = wksProduct.Columns("C:C").Find(strCat$, LookIn:=xlValues, lookat:=xlWhole) 'Recherche categorie dans la colonne C du tableau des profuits
        If Not rngCat Is Nothing Then 'si la categorie est trouvée
            strAddress$ = rngCat.Address
            Do 'Boucle 6 fois pour les 6 dernieres ref
                x = x + 1
                'ici on teste si la colonne 2 du tableau produit n'est pas la référence de la source, si non on ajoute la référence
                If wksProduct.Cells(rngCat.Row, 2) <> strRef$ Then stProductSim$ = stProductSim$ & wksProduct.Cells(rngCat.Row, 2) & ","
                Set rngCat = wksProduct.Columns("C:C").FindNext(rngCat) 'cherche une autre occurence en colonne C du tableau produit
                If rngCat.Address = strAddress$ Then Exit Do
            Loop Until x = 6
            If stProductSim$ <> vbNullString Then
                stProductSim$ = Left(stProductSim$, Len(stProductSim$) - 1)
                varArrTmp = Split(stProductSim$, ",")
                'ici on insère les données dans les colonnes 1,2,3,4,5,6 de la feuille source + la concaténation
                j = 5 'On commence par la colonne 1 soit la 5 dans la feuille
                wksSource.Cells(i, "D") = vbNullString
                For x = UBound(varArrTmp) To LBound(varArrTmp) Step -1
                    wksSource.Cells(i, j) = varArrTmp(x) 'insère la reférence
                    wksSource.Cells(i, "D") = wksSource.Cells(i, "D") & varArrTmp(x) & "," 'Insère la concatenation
                    j = j + 1
                Next x
            End If
            x = 0
            stProductSim$ = vbNullString
        End If
    Next i
    'tri feuille produi
    wksProduct.[A1].CurrentRegion.Sort Key1:=wksProduct.[A1], Order1:=xlAscending, Header:=xlYes
    Set wksSource = Nothing
    Set wksProduct = Nothing
End Sub

C’est top, merci bcp!