Tri de données en Excel

Bonjour,

J'ai un tableau X que je voudrais transformer pour avoir un tableau Y qui est présenté en annexe.

J'ai toutefois beaucoup de mal à expliquer ce que le souhaite.

Voir en annexe.

Merci d'avance.

Bonjour,
Peux-tu confirmer la version Excel 97-2003 ?
Cdlt.

Bonjour,

Microsoft 365

Bonsoir à tous !

Pour une aide adaptée de la communauté, merci de préciser, dans votre profil, la nature de votre Excel ( 2019 ? 2021 ? 365 ? ...)

Une proposition ?

bonsoir

une contribution adaptée à toutes les versions

cordialement

Bonsoir,

Désolé pour le retard .

Cela me semble un peu compliqué pour moi...

bonsoir

pour ne pas te laisser dans la mouise ,, j'ai fait simple avec des explications comme j'aurai aimé en avoir

cordialement

Bonjour le forum,

A l'aide du fichier fourni par tulipe_4 , résultat en Feuil3 préalablement créée.

Option Explicit
Sub test()
    Dim a, b, w, i As Long, j As Long, maxRow As Long
    Dim dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    a = Sheets("Feuil1").Range("a2").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 2 To UBound(a, 1)
        If Not dico.exists(a(i, 1)) Then
            j = j + 1
            If j > UBound(b, 2) Then
                ReDim Preserve b(1 To UBound(b, 1), 1 To j)
            End If
            b(1, j) = "SL " & a(i, 1)
            dico(a(i, 1)) = VBA.Array(1, j)
        End If
        w = dico(a(i, 1))
        w(0) = w(0) + 1
        b(w(0), w(1)) = a(i, 3)
        maxRow = Application.Max(maxRow, w(0))
        dico(a(i, 1)) = w
    Next
    Application.ScreenUpdating = False
    'Restitution en feuil3
    With Sheets("Feuil3")
        .Cells.Clear
        With .Range("a1").Resize(maxRow, UBound(b, 2))
            .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .Interior.ColorIndex = 42
                .BorderAround Weight:=xlThin
            End With
        End With
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Merci à vous, je regarde cela dès que possible.

Bàv

Bonsoir à tous ,

Ma p'tite version VBA. Cliquez sur le bouton Hop!

le code dans la module de la feuille "Feuil1" :

Sub Reor()
Dim r, t, ref, n&, i&, j&
   Application.ScreenUpdating = False
   If Me.FilterMode Then Me.ShowAllData
   Range("f1").CurrentRegion.Clear
   With Intersect(Range("a1").CurrentRegion, Columns("a:c"))
      r = .Value2
      .Sort [a1], xlAscending, Header:=xlYes, MatchCase:=False
      t = .Value2: .Value2 = r: ReDim r(1 To UBound(t), 1 To 1)
      ref = "": n = 1: j = Columns("f:f").Column - 1
      For i = 2 To UBound(t)
         If t(i, 1) <> ref Then
            If n > 1 Then j = j + 1: Cells(1, j).Resize(n) = r
            n = 1: ref = t(i, 1): r(n, 1) = "SI " & t(i, 1)
         End If
         n = n + 1: r(n, 1) = t(i, 3)
      Next i
      If n > 1 Then j = j + 1: Cells(1, j).Resize(n) = r
      Range(Range("f1"), Cells(1, j)).HorizontalAlignment = xlHAlignRight
      Range(Range("f1"), Cells(1, j)).Font.Bold = True
      Range(Range("f1"), Cells(1, j)).Interior.Color = RGB(250, 230, 255)
      Range("f1").CurrentRegion.Borders.LineStyle = xlContinuous
      Range(Range("f1"), Cells(1, j)).EntireColumn.AutoFit
   End With
End Sub

...