Excel, как преобразовать таблицу, которая будет использоваться для сводки: используйте заголовки столбцов в поле - PullRequest
Новая
       28

Excel, как преобразовать таблицу, которая будет использоваться для сводки: используйте заголовки столбцов в поле

0 голосов
/ 08 октября 2019

У меня есть таблица в Excel, которая заполняется, как показано ниже 

PROD         JAN-19     FEB-19    ...     ...

product1      123        098      ...     ...
product2      314        467      ...     ...

Мне нужно использовать данные в сводной таблице, поэтому я предполагаю, что мне нужно преобразовать модель данных следующим образом, используя MMM-Заголовок YY как данные в поле Год и Месяц. 

 PROD          Year    Month     Data

 Product1       19      JAN       123
 Product1       19      FEB       098
 ...           ...      ...       ...

Ниже экрана фактической таблицы и того, чего я хотел бы достичь: screen

Есть ли практический способ сделать это либо для работы с Datamodel, в которую загружается таблица, либо в качестве последнего варианта VBA?.

1 Ответ

0 голосов
/ 10 октября 2019

Преобразование массива с помощью Application.Index()

Этот подход сначала назначает значения таблицы массиву и в конечном итоге преобразует тот же массив в требуемую структуру, используя расширенные возможности Application.Index(). функция, таким образом, поддерживая названия продуктов.

Я не претендую на то, что это самый эффективный способ, но он ясно демонстрирует возможности цитируемой функции - ср Некоторые особенности функции Application.Index

Примечание: я предполагаю, что включены все данные за месяц, т.е. даже пустые значения. 

Sub Table2PivotBase()
' Purpose: Transform Table to Pivot base
' Method:  reorganize Datafield array of table using advanced features of Application.Index in [2]d)
' Note:    sheet references use the worksheet's CodeName property here
'~~~~~~~~~~~~ [0] Reference to table (address) ~~~~~~
Const MONTHSCOUNT& = 12, COLUMNOFFSET& = 1    ' number of months, column offset January = 1 (i.e. 2nd col)
With Sheet1
'a) Refer to table using the sheet's CodeName
    Dim rpt As ListObject
    Set rpt = .ListObjects("Table1")
Sheet1.CodeName
' ~~~~~~~~~~~ [1] Get Data ~~~~~~~~~~~~~~~~~~~~~~~~
'b) Assign table values in Sheet1 to 2-dim 1-based array
    Dim arr As Variant, yr&
    arr = .Range(rpt.Range.Address).Value2
'c) Extract current year from 1st month column in header (1+ coloffset 1 => 2nd column)
    yr = Val(Split(arr(1, 1 + COLUMNOFFSET) & "-", "-")(1))
End With

'~~~~~~~~~~~~~~ [2] Reorganize Data ~~~~~~~~~~~~~~~
'd) Redimension array preserving 1st column
    Dim arr2, ItemsCount&
    ItemsCount = UBound(arr) - IIf(rpt.ShowTotals, 1, 0)    ' exclude table totals from items count
    arr2 = Application.Index(arr, Application.Transpose(getRowsArr(ItemsCount, MONTHSCOUNT)), Array(1, 1, 1, 2))

'e) Redefine headers in 1st row
    Dim no&, headers
    headers = Array("Product", "Year", "Month", "Data")
    For no = 1 To 4
        arr2(1, no) = headers(no - 1)               ' headers are zerobased
    Next no
'f) Enter year, month & month data in a loop
    Const START& = 2
    Dim i&, mon&, ii&
    ii = START - 1
    For i = START To UBound(arr2)
            mon = (i - START) Mod MONTHSCOUNT + 1   ' 0 to 11 (omitting 1 caption row) + 1
            If mon = 1 Then ii = ii + 1             ' increment data row of arr1 in January

           'arr2(i, 1) has already been prefilled by section [2]d)
            arr2(i, 2) = yr
            arr2(i, 3) = Application.Text(DateSerial(yr, mon, 1), "mmm")
            arr2(i, 4) = arr(ii, mon + COLUMNOFFSET)
    Next i


'~~~~~~~~~~~~ ~[3] Write back pivot base to any sheet (via CodeName) ~~~~~~~~~~~
With Sheet2
    .Range("A:D") = vbNullString
    .Range("A1").Resize(UBound(arr2), UBound(arr2, 2)) = arr2
End With
End Sub

Вспомогательная функция getRowsArr()


Function getRowsArr(ByVal ItemsCount, Optional ByVal n& = 12) As Variant()
' Purpose: return 1-dim 0-based array containing n row numbers per item + title row no 1
' Note:    allows restructuring the original array to contain all months data
    Const START& = 2                        ' data rang starts in 2nd row
    Dim tmp(), i&, ii&
    ReDim tmp(0 To (ItemsCount - 1) * n)    ' includes header row number 1 at tmp(0) - zerobound!
'1) fill temporary array
    tmp(0) = 1                              ' title row no equals 1
    For i = START To ItemsCount             ' row no 2 to ...
        For ii = 0 To n - 1                 ' repeat row number n times
            tmp((i - START) * n + ii + 1) = i
        Next ii
    Next i
'2) return Array(1,2,2,2,2,2,2,2,2,2,2,2,2,3,........3,4...,...) as function value
    getRowsArr = tmp
    'Debug.Print Left$(Join(tmp, ","), 65) & "..."
End Function
...