excel - Excel如何转换要用于透视的表:在字段中使用列标题
问题描述
我在 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
... ... ... ...
是否有一种实用的方法可以在上传表的数据模型上工作或作为最后一个选项 VBA?
解决方案
数组变换通过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
推荐阅读
- reactjs - 在 mac 上为 react-native 环境安装 android studio 的问题
- javascript - 显示损坏的图标而不是带有替代文字的图像 - React
- excel - ExcelScript(在线):获取当前文件名
- swift - 获取段落的范围 NSAttributedString
- c# - Async Delegate EndInvoke 比预期提前终止循环
- c++ - 移动捕获调用 std::promise 的复制构造函数,而 std::unordered_map::emplace()
- javascript - 从单元格中获取字符串并进行比较以执行操作的函数
- python - 自定义周数 SQL
- excel - 如何使用宏来格式化任意大小的表格
- javascript - ProgessStep 注册页面上的无效挂钩调用