Cherche macro pour cet exemple

Bonjour,

Je cherche une macro pour un problème que je ne parvient pas à résoudre.

J'ai mis l'instruction dans le fichier excel afin mieux comprendre mon problème.

Je remercie d'avance votre aide,

Bonjour,

Teste ceci :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Tbl()
    Dim I As Long

    'défini la plage sur la colonne A de la feuille active à partir de A3
    With ActiveSheet

        Set Plage = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp))

    End With

    For Each Cel In Plage

        I = I + 1
        ReDim Preserve Tbl(1 To I)
        Tbl(I) = Cel.Value

        'si la cellule sous la cellule en cours est différente, double la valeur
        If Cel.Value <> Cel.Offset(1).Value Then

            I = I + 1
            ReDim Preserve Tbl(1 To I)
            Tbl(I) = Cel.Value

        End If

    Next Cel

    'transpose le tableau en colonne D de la feuille active à partir de D3
    Range(Cells(3, 4), Cells(UBound(Tbl) + 2, 4)).Value = Application.Transpose(Tbl)

End Sub

Bonjour maxjlaurent,

bonjour Theze,

Une autre méthode avec utilisation d'un dictionnaire.

A+