2009-09-16 22 views
0

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 1 ou plusieurs feuilles contenant les données de dotation réelle:Comment créer un tableau croisé dynamique consolidé lorsque les données source contiennent des en-têtes de colonne qui sont des dates?

Sample staff planning sheet

Le client souhaite consolider toutes les données de toutes ces nombreuses feuilles et classeurs en une seule table pivotante. Un pivot 'consolidé' n'est pas une option car il veut pouvoir jouer avec tous les champs (non datés) des données sources. 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éta-donné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». Puis j'étend les méta-données pour 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 une seule table pivotante à partir d'eux.

Cela fonctionne, mais c'est assez inefficace, puisque le nombre total de tâches/affectations est de plusieurs milliers. Dans mes rêves, j'aimerais éliminer complètement l'étape de la consolidation, mais je ne vois pas cela se produire. Une approche de consolidation plus efficace est sur le meilleur 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 sur Windows XP, Office 2002 et 2003.

Répondre

0

J'ai finalement trouvé un acceptable solution, si quelqu'un est intéressé. Il utilise une combinaison d'un tableau croisé dynamique et de la fonction TextToColumns. Une fois que j'ai eu l'approche, le turing dans le code était assez simple. Le code ci-dessous fait référence à quelques fonctions de convenance que j'utilise, telles que 'DeleteSheet' et 'LastRowOn', mais vous avez 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