Afficher Liste en Commentaire

Bonjour à Tous!

Je viens avec une nouvelle question et solliciter votre aide. Sur le classeur en PJ, j'ai sur la feuille "Liste MP AC" la liste des matières premières, sur la feuille "PF COMMUNS" j'ai la liste des produits avec pour chacun sa matière première, on constate qu'une matière première peut être commune à plusieurs produits finis.

Ma demande : est-il possible d'avoir la liste des produits communs à une matière en commentaire, pour chaque matière sur la feuille "Liste MP AC".

Sur le classeur j'ai mis un commentaire en exemple sur la cellule B7.

Merci à tous pour votre attention.

Bonjour,

Testes ce code pour voir si il convient :

Sub Commentaire()

    Dim PlageFe1 As Range
    Dim PlageFe2 As Range
    Dim CelFe1 As Range
    Dim CelFe2 As Range
    Dim Chaine As String
    Dim Adr As String

    Range("B4:AP53").ClearComments

    With Worksheets("Liste MP AC"): Set PlageFe1 = .Range(.Cells(7, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
    With Worksheets("PF COMMUNS"): Set PlageFe2 = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With

    PlageFe1.ClearComments

    For Each CelFe1 In PlageFe1

        Set CelFe2 = PlageFe2.Find(CelFe1.Value, PlageFe2(PlageFe2.Count, 1), xlValues, xlWhole)

        If Not CelFe2 Is Nothing Then

            Adr = CelFe2.Address

            Do

                Chaine = Chaine & CelFe2.Offset(, 1).Value & vbCrLf
                Set CelFe2 = PlageFe2.FindNext(CelFe2)

            Loop While Adr <> CelFe2.Address

        End If

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

        With CelFe1

            .AddComment
            .Comment.Visible = False
            .Comment.Text Chaine
            .Comment.Shape.TextFrame.AutoSize = True

        End With

        Chaine = ""

    Next CelFe1

End Sub

Bonjour Theze , Bonjour tous le monde!

Je vous remercie pour la réponse, j'ai mis le code dans un module, et il affecte les données correctement. Y aurait il possibilité d'avoir l’exécution du code en automatique.

Merci à vous.

Bonjour!

La macro me donne une erreur, dont je joins une capture d'ecran. Merci de m'indiquer comment résoudre ce problème.

Bonjour,

Probablement que la chaîne est vide (pas de valeur correspondante trouvée)

Bonjour!

Merci pour la réponse, si justement les deux tableaux sont pleins de données et en plus ils ont la même structure que celle que j'ai posté.

Je vais vérifier quand même encore les données et je reviens vers vous.

Merci encore

Je suis actuellement sur iPad je vérifierai plus tard

Re bonjour!

Merci beaucoup à vous Theze, j'ai revérifier les données, effectivement, des données manquées sur la 2eme feuille ce qui bloqué le bon déroulement de la macro.

Merci encore.

Bonjour,

Il te suffit de mettre en place un test :

Sub Commentaire()

    Dim PlageFe1 As Range
    Dim PlageFe2 As Range
    Dim CelFe1 As Range
    Dim CelFe2 As Range
    Dim Chaine As String
    Dim Adr As String

    Range("B4:AP53").ClearComments

    With Worksheets("Liste MP AC"): Set PlageFe1 = .Range(.Cells(7, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
    With Worksheets("PF COMMUNS"): Set PlageFe2 = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With

    PlageFe1.ClearComments

    For Each CelFe1 In PlageFe1

        Set CelFe2 = PlageFe2.Find(CelFe1.Value, PlageFe2(PlageFe2.Count, 1), xlValues, xlWhole)

        If Not CelFe2 Is Nothing Then

            Adr = CelFe2.Address

            Do

                Chaine = Chaine & CelFe2.Offset(, 1).Value & vbCrLf
                Set CelFe2 = PlageFe2.FindNext(CelFe2)

            Loop While Adr <> CelFe2.Address

        End If

        If Chaine <> "" Then

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

            With CelFe1

                .AddComment
                .Comment.Visible = False
                .Comment.Text Chaine
                .Comment.Shape.TextFrame.AutoSize = True

            End With

        End If

        Chaine = ""

    Next CelFe1

End Sub