Como construir uma tabela dinâmica consolidada quando os dados de origem contém cabeçalhos das colunas que são datas?

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

  •  07-07-2019
  •  | 
  •  

Pergunta

Eu tenho um cliente que está atualmente usando o Excel para fazer o seu planejamento de pessoal. Eles têm muitos livros para diferentes projetos e cada projeto contém 1 ou mais folhas contendo os dados de pessoal real:

folha de planejamento pessoal Amostra

O cliente quer consolidar todos os dados de todas estas muitas folhas e pastas de trabalho em uma única tabela pivô. Um pivot 'consolidada' não é uma opção, porque eles querem ser capaz de mexer com todos os (não-data) campos nos dados de origem. Eles não querem ser limitado a apenas 'Row' e 'Coluna'. Minha solução atual é uma macro que consolida todos os dados dentro de uma pasta de trabalho através de uma cópia bastante complicado e processo de rotação. Eu copiar uma linha de 'dados meta' (tudo o que não é uma data) em primeiro lugar, então eu copiar / transpor as datas para a linha de meta dados em uma única coluna 'Data'. Então eu estender os metadados de modo a que os mesmos dados são definidas para cada data.

I tem uma pasta de trabalho separada que agarra a folha consolidada a partir de cada livro e constrói uma única tabela pivô a partir deles.

Ele funciona, mas é muito ineficiente, uma vez que o número total de número de tarefas / trabalhos em muitos milhares. Em meus sonhos, eu gostaria de eliminar a etapa de consolidação completamente, mas eu não vejo isso acontecendo. A abordagem de consolidação mais eficiente é sobre o melhor que eu estou esperando para neste momento.

Se alguém tem alguns 'fora da caixa' idéias, eu sou todo ouvidos! As soluções necessidades para funcionar no Windows XP, Office 2002 e 2003.

Foi útil?

Solução

I finalmente encontrada uma solução aceitável , se alguém estiver interessado. É usa uma combinação de uma tabela dinâmica eo TextToColumns função. Uma vez eu tive a abordagem, Turing-lo em código era muito simples. O código abaixo se refere a algumas funções conveniance eu uso, tais como 'DeleteSheet' e 'LastRowOn', mas você começa a idéia.

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 em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top