¿Cómo construir una tabla dinámica consolidada cuando los datos de origen contienen encabezados de columna que son fechas?

StackOverflow https://stackoverflow.com/questions/1434306

  •  07-07-2019
  •  | 
  •  

Pregunta

Tengo un cliente que actualmente utiliza Excel para planificar su personal. Tienen muchos libros de trabajo para diferentes proyectos y cada proyecto contiene 1 o más hojas que contienen los datos reales de personal:

Ejemplo de hoja de planificación del personal

El cliente desea consolidar todos los datos de todas estas hojas y libros de trabajo en una sola tabla dinámica. Un pivote 'consolidado' no es una opción porque quieren poder meterse con todos los campos (sin fecha) en los datos de origen. No quieren limitarse solo a 'Fila' y 'Columna'. Mi solución actual es una macro que consolida todos los datos dentro de un libro de trabajo a través de un proceso de copia y rotación bastante complicado. Copio primero una fila de 'metadatos' (todo lo que no es una fecha), luego copio / transpongo las fechas para la fila de metadatos en una sola columna 'Fecha'. Luego extiendo los metadatos para que se definan los mismos datos para cada fecha.

Tengo un libro de trabajo separado que toma la hoja consolidada de cada libro de trabajo y crea una única tabla dinámica a partir de ellos.

Funciona, pero es bastante ineficiente, ya que el número total de tareas / tareas asciende a miles. En mis sueños, me encantaría eliminar por completo el paso de consolidación, pero no veo que eso suceda. Un enfoque de consolidación más eficiente es lo mejor que espero en este momento.

Si alguien tiene algunas ideas 'fuera de la caja', ¡soy todo oídos! Las soluciones deben funcionar en Windows XP, Office 2002 y 2003.

¿Fue útil?

Solución

Finalmente encontré una solución aceptable , si alguien está interesado. Utiliza una combinación de una tabla dinámica y el TextToColumns función. Una vez que tuve el enfoque, convertirlo en código fue bastante simple. El siguiente código hace referencia a algunas funciones de conveniencia que uso, como 'DeleteSheet' y 'LastRowOn', pero se entiende la idea.

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
Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top