Comment transposer un tableau avec plusieurs colonnes

Bonjour à tous !

Je m'adresse à vous car je suis confrontée à un pb et je ne sais pas comment le résoudre "proprement".

J'ai un tableau avec 4 colonnes une colonne date et 3 colonnes lecteurs. Je souhaiterais créer un tableau qui me donne pour une date le nombre de fois que le lecteur est passé.

Je voudrais synthétiser le tableau A avec un tableau B. Sans forcément écrire une macro je suis ( presque) certaine que ça existe :) ( ou peut être que je me trompe)

Vous trouverez ci joint le fichier que j'utilise.

Merci de m'avoir lu et pour votre aide :)

Bonne soirée !

A.

Bonsoir à tous !

Si vous avez la possibilité d'installer un complément gratuit de Microsoft, Power Query (nativement intégré dans les versions postérieures à Excel 2013) pourra retraiter votre tableau source pour le restituer dans un rapport de TCD.

Bonjour à tous,

Merci pour ton retour JFL, j'ai bien Microsoft, Power Query malheureusement je ne maitrise pas du tout le fonctionnement je vais essayer de trouver la solution, si jamais tu as des pistes je suis preneuse !

Merci beaucoup !

A

Bonjour à tous !

Anais83 a écrit :

...... j'ai bien Microsoft, Power Query malheureusement je ne maitrise pas du tout le fonctionnement

Excellente occasion pour.... apprendre ! Power Query est un outil fantastique.

Si l'envie (ou le temps ou le courage) manque à l'appel, peut-être qu'une âme charitable et spécialisée en VBA vous viendra en aide.

Bonjour JFL,

J'ai commencé les tutos Power Query c'est vraiment bien, espérons que je sois opérationnelle à temps .
J'ai une macro qui fait le travail mais justement je voulais éviter de passer par une macro :)

Merci pour ton aide et bonne journée à tous !

A

Bonsoir à tous,

Comme tu aimes bien les macros, en voilà une

Option Explicit
Sub test()
    Dim a, e, s, i As Long, ii As Byte, n As Long, dico As Object
    Application.ScreenUpdating = False
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("sheet1")
        a = .Range("a3").CurrentRegion
        For i = 2 To UBound(a, 1)
            If Not dico.exists(a(i, 1)) Then
                Set dico(a(i, 1)) = CreateObject("Scripting.Dictionary")
            End If
            For ii = 2 To UBound(a, 2)
                If Not dico(a(i, 1)).exists(a(i, ii)) Then
                    ReDim w(1 To 3):  w(2) = a(i, ii)
                    If dico(a(i, 1)).Count = 0 Then w(1) = a(i, 1)
                Else
                    w = dico(a(i, 1))(a(i, ii))
                End If
                w(3) = w(3) + 1
                dico(a(i, 1))(a(i, ii)) = w
            Next
        Next
    End With
    With Sheets.Add
        n = 2
        .Cells(1).Resize(, 3) = [{"Date","Lecteur","Nombre"}]
        For Each e In dico
            For Each s In dico(e)
                .Cells(n, 1).Resize(, UBound(dico(e)(s))) = dico(e)(s)
                n = n + 1
            Next
            .Cells(n, "a").Value = "Total " & e
            .Cells(n, "c").FormulaR1C1 = "=sum(r" & n - 1 & "c:r[-" & dico(e).Count & "]c)"
            With .Cells(n - dico(e).Count, "a").Resize(dico(e).Count, 3)
                .BorderAround Weight:=2
            End With
            n = n + 1
         Next
         With .Cells(1).CurrentRegion
            .Font.Name = "Calibri"
            .Font.Size = 10
            .Rows(1).BorderAround Weight:=2
            .Rows(1).Interior.ColorIndex = 45
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=2
            .Borders(xlInsideVertical).Weight = 2
            .Columns.AutoFit
         End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonsoir,
Tardivement, mais !
Cdlt.

Option Explicit

Public Sub ConsolidateData()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim PT As PivotTable
Dim tbl As Variant, arr() As Variant
Dim rCell As Range
Dim lastRow As Long, lastCol As Long, i As Long, j As Long, k As Long

    Application.ScreenUpdating = False

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("Données")
    Set wsPT = wb.Worksheets("TCD")

    With wsPT
        With .ListObjects(1)
            If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
            Set rCell = .InsertRowRange.Cells(1)
        End With
    End With

    With wsData
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        tbl = .Cells(2, 1).Resize(lastRow - 1, lastCol).Value
    End With

    For i = 1 To UBound(tbl)
        For j = 2 To UBound(tbl, 2)
            If tbl(i, j) <> "" Then
                ReDim Preserve arr(2, k + 1)
                arr(0, k) = CLng(tbl(i, 1))
                arr(1, k) = tbl(i, j)
                k = k + 1
            End If
        Next j
    Next i

    If k > 0 Then
        rCell.Resize(k, 2).Value = Application.Transpose(arr)
        With wsPT
            .Activate
            .Cells(1, 4).Select
            .PivotTables(1).RefreshTable
        End With
    End If

End Sub