Création de flèches pointant d'une colonne vers une autre

Bonjour tout le monde,

J'ai une petite question à vous poser.

J'ai 2 listes à comparer, où figurent les mêmes items mais dans un ordre différent.

exemple

Banane Poire

Ananas Banane

Poire Ananas

Je souhaite créer une macro qui afficherait des fleches reliant les items de la colonne 1 à la colonne 2

Pouvez-vous m'aider à ce sujet ?

Merci d'avance

bonjour,

voici une proposition. les deux colonnes doivent être séparées par au moins une colonne.

Sub aargh()
    For Each sh In ActiveSheet.Shapes
        sh.Delete
    Next
    dl = Cells(Rows.Count, 1).End(xlUp).Row
    Set r = Range("C1:C" & dl)
    For i = 1 To dl
        Set re = r.Find(Cells(i, 1), lookat:=xlWhole)
        If Not re Is Nothing Then
            d = re.Row
            x1 = Cells(i, 1).Top + Cells(i, 1).Height / 2
            y1 = Cells(i, 1).Left + Cells(i, 1).Width
            x2 = Cells(d, 3).Top + Cells(d, 3).Height / 2
            y2 = Cells(d, 3).Left
            Set sh = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, y1, x1, y2, x2)
            sh.Line.EndArrowheadStyle = msoArrowheadTriangle
        End If
    Next i
End Sub

Bonjour H2SO4,

Tout d'abord un énorme merci pour ta réponse.

La macro marche bien lorsque j'ouvre un nouveau classeur et que je met les éléments en colonnes A et C.

En l'occurence, mon fichier est un peu plus complexes et les colonnes en questions sont la C et la P.

Quels éléments dois-je modifier dans ta macro pour que celle-ci fonctionne.

Encore merci !

bonjour,

caode adapté

Sub aargh()
    c1 = "C" 'colonne 1
    c2 = "P" 'colonne 2
    For Each sh In ActiveSheet.Shapes
    sh.Delete
    Next
    dl = Cells(Rows.Count, c1).End(xlUp).Row
    Set r = Range(c2 & "1:" & c2 & dl)
    For i = 1 To dl
        Set re = r.Find(Cells(i, c1), lookat:=xlWhole)
        If Not re Is Nothing Then
            d = re.Row
            x1 = Cells(i, c1).Top + Cells(i, c1).Height / 2
            y1 = Cells(i, c1).Left + Cells(i, c1).Width
            x2 = Cells(d, c2).Top + Cells(d, c2).Height / 2
            y2 = Cells(d, c2).Left
            Set sh = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, y1, x1, y2, x2)
            sh.Line.EndArrowheadStyle = msoArrowheadTriangle
        End If
    Next i
End Sub

Génial !

Merci beaucoup !