Mise en forme de tableau particulière

Bonjour

Tous les mois j incremente un tableau qui trace : la date , et les valeurs d'un certains nombre de champs par produit

j'aurai voulu pouvoir le mettre sous une forme ou les date seraient en colonne afin de mieux intercomparer des données texte pas seulement numeriques

j ai essaye de formaliser ca dans l exemple joint

Davance merci de votre aide

Bonsoir crackersb

A tester :

Option Explicit
Sub test()
Dim a, b(), dico1 As Object, dico2 As Object
Dim i As Long, j As Byte, n As Long, t As Long, txt As String
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.CompareMode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.CompareMode = 1
    With Sheets("Feuil1").Range("a2").CurrentRegion
        a = Application.Index(.Value, Evaluate("row(1:" & _
                                               .Rows.Count & ")"), Array(1, 4, 2, 3, 5, 6))
        n = 2: t = 1
        For i = 2 To UBound(a, 1)
            If Not dico1.exists(a(i, 1)) Then
                n = n + 1
                dico1(a(i, 1)) = n
            End If
        Next
        For j = 3 To UBound(a, 2)
            For i = 2 To UBound(a, 1)
                txt = Join$(Array(a(1, j), a(i, 2)), "|")
                If Not dico2.exists(txt) Then
                    t = t + 1
                    dico2(txt) = t
                End If
            Next
        Next
        ReDim b(1 To dico1.Count + 2, 1 To dico2.Count + 1)
        For i = 0 To dico1.Count - 1
            b(i + 3, 1) = dico1.keys()(i)
        Next
        For j = 0 To dico2.Count - 1
            b(1, j + 2) = Split(dico2.keys()(j), "|")(1)
            b(2, j + 2) = Split(dico2.keys()(j), "|")(0)
        Next
        For i = 2 To UBound(a, 1)
            For j = 3 To UBound(a, 2)
                txt = Join$(Array(a(1, j), a(i, 2)), "|")
                b(dico1(a(i, 1)), dico2(txt)) = a(i, j)
            Next
        Next
    End With
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Restitution").Delete
    Sheets.Add().Name = "Restitution"
    On Error GoTo 0
    With Sheets("Restitution").Cells(1)
        With .Resize(UBound(b, 1), UBound(b, 2))
            .CurrentRegion.Clear
            .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .VerticalAlignment = xlCenter
            With .Rows(1).Offset(, 1).Resize(, .Columns.Count - 1)
                .BorderAround Weight:=xlThin
                .Interior.ColorIndex = 15
                .Offset(1).Interior.ColorIndex = 40
                With .Resize(2)
                    .HorizontalAlignment = xlCenter
                End With
            End With
            With .Offset(2).Resize(.Rows.Count - 2)
                .Columns(1).Interior.ColorIndex = 36
                .BorderAround Weight:=xlThin
            End With
        End With
    End With
    Set dico1 = Nothing: Set dico2 = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Un super grand Merci

Ca donne super bien ... avec le fichier test

je vais essayer grandeur nature

Pourrais tu me documenter, la macro dans le cas ou je voudrai rajouter des colonnes pour comparer plus de champs stp

j ai trouve comment rajouter des colonnes excellent ca fonctionne nickel un grand grand merci