소스 데이터에 날짜 인 열 제목이 포함되어있을 때 통합 피벗 테이블을 작성하는 방법은 무엇입니까?

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

  •  07-07-2019
  •  | 
  •  

문제

현재 Excel을 사용하여 직원 계획을 수행하는 고객이 있습니다. 다른 프로젝트에 대한 많은 통합 문서가 있으며 각 프로젝트에는 실제 직원 데이터가 포함 된 1 개 이상의 시트가 포함되어 있습니다.

Sample staff planning sheet

고객은이 모든 시트와 통합 문서의 모든 데이터를 단일 피벗 테이블로 통합하려고합니다. '통합'피벗은 소스 데이터의 모든 (비) 필드를 엉망으로 만들 수 있기 때문에 옵션이 아닙니다. 그들은 '행'과 '열'으로만 제한되기를 원하지 않습니다. 내 현재 솔루션은 상당히 복잡한 사본 및 회전 프로세스를 통해 통합 문서 내의 모든 데이터를 통합하는 매크로입니다. 먼저 '메타 데이터'행 (날짜가 아닌 모든 것)을 복사 한 다음 메타 데이터 행의 날짜를 단일 '날짜'열로 복사 / 전환합니다. 그런 다음 각 날짜마다 동일한 데이터가 정의되도록 메타 데이터를 확장합니다.

각 통합 문서에서 통합 시트를 잡고 단일 피벗 테이블을 작성하는 별도의 통합 문서가 있습니다.

작동하지만 수천 명의 총 작업 / 할당 번호가 있기 때문에 매우 비효율적입니다. 내 꿈에서, 나는 통합 단계를 완전히 제거하고 싶지만, 그런 일이 일어나지 않는다. 보다 효율적인 통합 접근법은이 시점에서 내가 바라고 가장 좋은 것입니다.

누구든지 '상자 밖에'아이디어가 있다면 나는 모두 귀입니다! 솔루션은 Windows XP, Office 2002 및 2003에서 작동해야합니다.

도움이 되었습니까?

해결책

나는 마침내 An을 발견했다 허용되는 솔루션, 누구든지 관심이 있다면. 그것은 피벗 테이블과 TextTocolumns 기능. 일단 접근 한 후에는 코드로 연결하는 것이 매우 간단했습니다. 아래 코드는 'deletesheet'및 'lastrowon'과 같은 몇 가지 소집 기능을 참조하지만 아이디어를 얻습니다.

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
라이센스 : CC-BY-SA ~와 함께 속성
제휴하지 않습니다 StackOverflow
scroll top