Regroupement de lignes

Bonjour,

J'ai un problème et je ne sais pas quel bout le prendre.

J'ai plusieurs lignes sous cette forme

• aa 1
  aa 8
  aa 9
  aa 15
  bb 8
  bb 2
  bb 3e
  c 8
  bb 9a
  bb 7
  bb 250
  d 48
  d 48a
  d 50

Et j'aimerai obtenir ce résultat :

• aa 1-8-9-15
  bb 8-2-3e
  c 8
  bb 9a-7-250
  d 48-48a-50

Je souhaiterai donc que dès que deux lignes qui se suivent ont la même info en colonne A, on puisse regrouper l'ensemble des colonnes B correspondantes avec une séparation par -

Une idée de la manière de faire ?

Je joints un fichier pour plus de compréhension

Merci d'avance

bonjour,

une proposition

Sub aargh()
    Dim tabr()
    With Sheets("base")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        Sheets("resultat").Cells.ClearContents
        .Range("A1").Resize(dl, 2).Copy Sheets("resultat").Range("A1")
    End With
    With Sheets("resultat")
        .Range("A1").Resize(dl, 2).Sort key1:=.Range("A1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending, Header:=xlNo
        ReDim tabr(1 To dl, 1 To 2)
        pt = 0
        vp = ""
        For i = 1 To dl
            If .Cells(i, 1) = vp Then
                tabr(pt, 2) = tabr(pt, 2) & "-" & .Cells(i, 2)
            Else
                pt = pt + 1
                tabr(pt, 1) = .Cells(i, 1)
                tabr(pt, 2) = .Cells(i, 2)
                vp = .Cells(i, 1)
            End If
        Next i
        .Cells.ClearContents
        .Range("A1").Resize(pt, 2) = tabr
    End With
End Sub

Bonjour,

Une autre proposition (je suis retombé sur un post où j'étais à ta place il y a 3 ans, ça ne nous rajeunit pas ).

Bon WE !

Bonjour à vous deux et merci pour votre aide, mais ce n'est pas exactement ce que je cherche.

Je ne souhaite pas regrouper tout ensemble mais bien suivre l'ordre qui est en place donc pour les bb il faudrait deux lignes, une avant les cc et une après et avoir au final exactement ce que j'ai sur ma feuille résultat.

bonjour,

Je ne souhaite pas regrouper tout ensemble mais bien suivre l'ordre qui est en place

dans ce cas il suffit d'enlever l'instruction de tri

Sub aargh()
    Dim tabr()
    With Sheets("base")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        Sheets("resultat").Cells.ClearContents
        .Range("A1").Resize(dl, 2).Copy Sheets("resultat").Range("A1")
    End With
    With Sheets("resultat")
        '.Range("A1").Resize(dl, 2).Sort key1:=.Range("A1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending, Header:=xlNo
        ReDim tabr(1 To dl, 1 To 2)
        pt = 0
        vp = ""
        For i = 1 To dl
            If .Cells(i, 1) = vp Then
                tabr(pt, 2) = tabr(pt, 2) & "-" & .Cells(i, 2)
            Else
                pt = pt + 1
                tabr(pt, 1) = .Cells(i, 1)
                tabr(pt, 2) = .Cells(i, 2)
                vp = .Cells(i, 1)
            End If
        Next i
        .Cells.ClearContents
        .Range("A1").Resize(pt, 2) = tabr
    End With
End Sub

Bonjour,

Une proposition à étudier.

Elle est réalisée avec Power Query. C'est un complément gratuit à télécharger et à installer (?).

A te relire.

Cdlt.

Parfait, merci à vous deux