Как построить сводную сводную таблицу, когда исходные данные содержат заголовки столбцов, которые являются датами?
-
07-07-2019 - |
Вопрос
У меня есть клиент, который в настоящее время использует Excel для планирования своего персонала. У них есть много рабочих книг для разных проектов, и каждый проект содержит 1 или более листов, содержащих фактические данные о персонале:
Клиент хочет объединить все данные из всех этих многочисленных листов и рабочих книг в единую сводную таблицу. «Сводная» сводная точка не является опцией, поскольку они хотят иметь возможность связываться со всеми (не датированными) полями в исходных данных. Они не хотят ограничиваться только «строкой» и «столбцом». Мое текущее решение - это макрос, который объединяет все данные в рабочей книге с помощью довольно сложного процесса копирования и поворота. Сначала я копирую строку «метаданных» (все, что не является датой), а затем копирую / перемещаю даты для строки метаданных в один столбец «Дата». Затем я расширяю метаданные, чтобы одни и те же данные определялись для каждой даты.
У меня есть отдельная рабочая книга, которая берет сводный лист из каждой рабочей книги и строит из них одну сводную таблицу.
Это работает, но довольно неэффективно, поскольку общее количество задач / заданий исчисляется многими тысячами. В своих снах я хотел бы полностью исключить этап консолидации, но я не вижу, чтобы это произошло. Более эффективный подход к консолидации - это лучшее, на что я надеюсь в данный момент.
Если у кого-то есть идеи «нестандартно», я весь в ушах! Решения должны работать на Windows XP, Office 2002 и 2003.
Решение
Я наконец нашел приемлемое решение , если кому-то интересно. Он использует комбинацию сводной таблицы и 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