代码之家 › 专栏 › 技术社区 › DaveParillo

当源数据包含日期为的列标题时,如何构建合并数据透视表?

consolidation pivot excel

0

DaveParillo · 技术社区 · 17 年前

我有一位客户目前正在使用Excel进行员工规划。他们有许多不同项目的工作手册,每个项目包含一张或多张包含实际人员配置数据的表格:

Sample staff planning sheet

客户希望将所有这些工作表和工作簿中的所有数据合并到一个数据透视表中。“合并”透视不是一个选项,因为他们希望能够处理源数据中的所有(非日期)字段。他们不希望仅限于“行”和“列”。我目前的解决方案是一个宏,它通过一个相当复杂的复制和旋转过程整合工作簿中的所有数据。我首先复制一行“元数据”(不是日期的所有内容),然后将元数据行的日期复制/转换为单个“日期”列。然后我扩展元数据,以便为每个日期定义相同的数据。

我有一个单独的工作簿,它从每个工作簿中获取合并的工作表,并从中构建单个数据透视表。

它可以工作,但效率很低,因为任务/任务的总数达到数千。在我的梦中,我希望完全消除整合步骤,但我看不到这种情况发生。在这一点上,我希望有一种更有效的整合方法。

如果有人有一些“开箱即用”的想法,我洗耳恭听! 这些解决方案需要在windows XP、Office 2002和2003上运行。

1 回复 | 直到 9 年前

1

0

DaveParillo 16 年前

我终于找到了一份工作 acceptable solution TextToColumns 作用一旦我有了这个方法,把它转换成代码就非常简单了。下面的代码确实引用了我使用的一些conveniance函数,例如“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