Transformer plusieurs lignes produit en une seule ligne

Bonjour à tous,

Je suis plutôt novice sur Excel et je rencontre aujourd'hui un problème auquel je ne trouve aucune solution.

Vous trouverez en pièce jointe une feuille Excel comportant deux onglets, le premier démontre la situation actuelle, le second la forme que j'aimerais avoir.

Dans ce cas cela paraît simple et je pourrais le faire manuellement, mais le fichier réel comporte plus de 2000 lignes ce qui rend le travail plutôt....... fatiguant.

Avez vous une solution à ce problème?

Peu importe si vous pouvez m'aider ou pas, merci beaucoup en avance et bonne journée à tous!!

FourStroke

Bonsoir FourStroke,

Vois ceci :

Option Explicit
Sub test()
Dim a, b(), dico1 As Object, dico2 As Object, i As Long, n As Long, t As Long
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.CompareMode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.CompareMode = 1
    a = Sheets("Actuel").Range("a1").CurrentRegion.Value
    n = 1: t = 1
    For i = 2 To UBound(a, 1)
        If Not dico1.exists(a(i, 2)) Then
            n = n + 1: dico1(a(i, 2)) = n
        End If
        If Not dico2.exists(a(i, 1)) Then
            t = t + 1: dico2(a(i, 1)) = t
        End If
    Next
    ReDim b(1 To dico1.Count + 1, 1 To dico2.Count + 1)
    b(1, 1) = a(1, 2)
    For i = 0 To dico1.Count - 1
        b(i + 2, 1) = dico1.keys()(i)
    Next
    For i = 0 To dico2.Count - 1
        b(1, i + 2) = dico2.keys()(i)
    Next
    For i = 2 To UBound(a, 1)
        b(dico1(a(i, 2)), dico2(a(i, 1))) = b(dico1(a(i, 2)), dico2(a(i, 1))) + 1
    Next
    Application.ScreenUpdating = False
    With Sheets("Souhait").Cells(1)
        .CurrentRegion.Clear
        With .Resize(UBound(b, 1), UBound(b, 2))
            .Value = b
            With .Font
                .Name = "calibri"
                .Size = 10
            End With
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders(xlInsideVertical).Weight = xlThin
            .BorderAround Weight:=xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .Font.Size = 11
                .Interior.ColorIndex = 19
                With .Offset(, 1).Resize(, .Columns.Count - 1)
                    .Interior.ColorIndex = 43
                End With
            End With
            With .Columns(1)
                With .Offset(1).Resize(.Rows.Count - 1)
                    .Interior.ColorIndex = 44
                End With
            End With
            .Parent.Select
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour Klin89!

Merci beaucoup pour cette réponse rapide!

N'étant pas familier (du tout) avec le VBA, pourriez vous ajouter vos commentaires au code s'il vous plaît?

Merci d'avance

FourStroke