Comment créer un tableau croisé dynamique consolidé lorsque les données source contiennent des en-têtes de colonne qui sont des dates?

Question

J'ai un client qui utilise actuellement Excel pour planifier son personnel. Ils ont de nombreux classeurs pour différents projets et chaque projet contient une ou plusieurs feuilles contenant les données de dotation réelles:

Le client souhaite consolider toutes les données de ces nombreuses feuilles et classeurs dans un seul tableau croisé dynamique. Un pivot "consolidé" n'est pas une option, car ils veulent pouvoir manipuler tous les champs (non datés) des données source. Ils ne veulent pas se limiter à 'Row' et à 'Column'. Ma solution actuelle est une macro qui consolide toutes les données d'un classeur via un processus de copie et de rotation assez compliqué. Je copie d'abord une ligne de «métadonnées» (tout ce qui n'est pas une date), puis je copie / transpose les dates de la ligne de métadonnées dans une seule colonne «Date». J'étends ensuite les métadonnées de sorte que les mêmes données soient définies pour chaque date.

J'ai un classeur séparé qui récupère la feuille consolidée de chaque classeur et construit un tableau croisé dynamique à partir de celui-ci.

Cela fonctionne, mais c'est assez inefficace, car le nombre total de tâches / missions se compte dans les milliers. Dans mes rêves, j'aimerais éliminer complètement l'étape de consolidation, mais je ne vois pas cela se produire. Une approche de consolidation plus efficace est à peu près la meilleure que j'espère pour le moment.

Si quelqu'un a des idées hors des sentiers battus, je suis tout ouïe! Les solutions doivent fonctionner sous Windows XP, Office 2002 et 2003.

Answer 1

J'ai finalement trouvé une solution acceptable , si quelqu'un est intéressé. Il utilise une combinaison de tableau croisé dynamique et de TextToColumns fonction. Une fois que j'ai eu l'approche, il était assez simple de l'intégrer dans le code. Le code ci-dessous fait référence à quelques fonctions de conveniance que j'utilise, telles que 'DeleteSheet' et 'LastRowOn', mais vous avez compris l'idée.

Sub Foo()
    Dim ws As Worksheet
    For Each ws In Worksheets
        If IsStaffingSheet(ws) Then
            ws.Select
            DeleteSheet ws.Name & " - Exploded"
            TransposeSheet ws
        End If
    Next ws

End Sub

Sub TransposeSheet(ByVal ParentSheet As Worksheet)
    Dim ws As Worksheet
    Dim r As Range
    Dim ref As Variant
    Dim pt As PivotTable

    Set r = Range("StaffingStartCell")
    Set r = Range(r, r.SpecialCells(xlLastCell))

    ref = Array("'" & ActiveSheet.Name _
                    & "'!" & r.Address(ReferenceStyle:=xlR1C1))

    Application.CutCopyMode = False
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlConsolidation, _
                                   SourceData:=ref).CreatePivotTable TableDestination:="", _
        tableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion10

    Set ws = ActiveSheet
    Set pt = ws.PivotTableWizard(TableDestination:=ActiveSheet.Cells(3, 1))
    pt.DataPivotField.PivotItems("Count of Value").Position = 1
    pt.PivotFields("Row").PivotItems("").Visible = False

    ExplodePivot ParentSheet
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True

    Set ws = Nothing
End Sub


Sub ExplodePivot(ByVal ParentSheet As Worksheet)
    Dim lastRow As Long
    Dim lastCol As Long

    lastRow = LastRowOn(ActiveSheet.Name)
    lastCol = LastColumnBack(ActiveSheet, lastRow)

    Cells(lastRow, lastCol).ShowDetail = True

    Columns("B:C").Select
    Selection.Cut Destination:=Columns("S:T")

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), _
                            DataType:=xlDelimited, _
                            Semicolon:=True
    Selection.ColumnWidth = 12
    ActiveSheet.Name = ParentSheet.Name & " - Exploded"
End Sub