Boucles

Bonjour,

il y a quelques temps j'ai posé ce problème

J'ai un tableau:

A | A1 | A2-1

A | A1 | A2-2

B | B1 | B2-2

la macro du dessous me donne cela

A

A1

A2-1

A

A1

A2-2

B

B1

B2-2

Sub Test()
    Dim a$, b$, i%, n%, it%, T()
    With ActiveSheet 'si lancement à partir feuille, sinon à préciser
       n = 4 'dernière ligne du tableau source commençant ligne 2
           'devra être calculée selon méthode adaptée au contexte réel
       For i = 2 To n
            If .Cells(i, 1) <> a Then
                a = .Cells(i, 1): it = it + 1
                ReDim Preserve T(1 To 3, 1 To it): T(1, it) = a
            End If
            If .Cells(i, 2) <> b Then
                b = .Cells(i, 2): it = it + 1
                ReDim Preserve T(1 To 3, 1 To it): T(2, it) = b
            End If
            it = it + 1: ReDim Preserve T(1 To 3, 1 To it): T(3, it) = .Cells(i, 3)
            'si 3e colonne toujours servie, sinon, sous test...
       Next i
        n = n + 10 'juste pour positionner résultats du test, à voir selon destination réelle
       With .Cells(n, 1).Resize(it, 3)
            .Value = WorksheetFunction.Transpose(T)
            .HorizontalAlignment = xlCenter
            With .Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        End With
    End With
End Sub

par contre je n'arrive pas à l'adapter si le tableau est désormais celui ci

A | A | A1 | A2 |A2-1|A2-2

A | A | A1 | A2 |A3-1|A3-2

B | B | B1 | B2 | B3-1| B3-2

et que le resultat attendu est

A

A

A1

A2

A2-1

A2-2

A3-1

A3-2

B

B

B1

B2

B3-1

B3-2

Bonjour,

Pour tester mon code, ta plage doit commencer en A1 (la plage est définie avec "CurrentRegion" de A1) et le résultat sera en colonne H :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim CelTrouve As Range
    Dim I As Integer

    Set Plage = Range("A1").CurrentRegion

    For Each Cel In Plage
        If Cel.Row > 1 Then
            Set CelTrouve = Plage.Rows(Cel.Row - 1).Find(Cel.Value, , xlValues, xlWhole)

            If CelTrouve Is Nothing Then

                I = I + 1
                Range("H" & I).Value = Cel.Value

            End If

        Else

            I = I + 1
            Range("H" & I).Value = Cel.Value

        End If

    Next Cel

End Sub

Merci,

ça correspond à ma demande

je vais étudier le code