0

現在、Excel を使用して人員計画を立てている顧客がいます。さまざまなプロジェクト用に多くのワークブックがあり、各プロジェクトには実際の人員配置データを含む 1 つ以上のシートが含まれています。

スタッフ計画シートのサンプル

顧客は、これらの多くのシートとワークブックのすべてのデータを 1 つのピボット テーブルに統合したいと考えています。ソース データのすべての (日付以外の) フィールドをいじりたいため、「統合された」ピボットはオプションではありません。「行」と「列」だけに限定されたくありません。私の現在の解決策は、かなり複雑なコピーと回転のプロセスを通じてブック内のすべてのデータを統合するマクロです。最初に「メタデータ」(日付以外のすべて) の行をコピーしてから、メタデータ行の日付を単一の「日付」列にコピー/転置します。次に、メタデータを拡張して、各日付に同じデータが定義されるようにします。

各ワークブックから統合シートを取得し、それらから 1 つのピボット テーブルを作成する別のワークブックがあります。

機能しますが、タスク/割り当ての総数が数千になるため、かなり非効率的です。私の夢では、統合ステップを完全になくしたいと思っていますが、それが実現するとは思いません。より効率的な統合アプローチは、現時点で私が望んでいる最高のものです。

誰かが「型にはまらない」アイデアを持っているなら、私はすべて耳を傾けます! このソリューションは、Windows XP、Office 2002 および 2003 で動作する必要があります。

4

1 に答える 1

0

誰かが興味を持っているなら、私は最終的に許容できる解決策を見つけました。ピボット テーブルと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
于 2009-11-05T17:42:26.933 に答える