如何将多个列转换为 VBA 中的三个堆叠列集？
How do I transform multiple columns to a stacked column set of three in VBA?
我有 12 个月的数据（见图一），按 Date-Jan、Day、Hours/Date-Feb、Day、Hours 等列...总共 36 列。
我正在尝试将 sheet 转换为新的 sheet 报告样式，它应该看起来是堆叠的（参见图 2），它应该有四列（员工的姓名）、日期, 日, 小时。
注意事项：
它必须是 reference - 所以当我在 中更改 sheet1 中的时间时，会自动更新 sheet2。没有复制粘贴。 （所以像例子（=b2））（不需要反转）。
如果我尝试每三列重复一次，请记住每个月都有 不同的天数，我们不希望出现空行。
我在考虑 vlookup 或索引函数，但似乎无法实现
正如@PEH 在评论中正确提到的那样，关于更改月份长度 和 没有 “完美的解决方案” 您的要求 “它必须是一个参考 - 所以当我在工作表 2 中自动更新时更改工作表 1 中的小时数”
VBA 运行-没有直接引用
(c.f. ►2nd post 开发单个动态公式参考)
由于 31 x 36 数据单元格范围的固定结构，您可以，但是
- 提供一个
包含 31*12 行 和 4 列 (Name,Date,Day,Hours) 的报告数组，
- 您填写员工姓名（第 1 列），
calculated dates（假定：字符串！）范围从 1 到最大值。 31 天（第 2 和 3 栏），
以及 小时 从源
按列读入
- 并写回任何想要的目标。
调用示例[=62=]
根据您的需要更改工作表指示。
Sub WriteReport()
'A) create report
Dim report As Variant
report = getReport("Bob Smith", ThisWorkbook.Worksheets("Sheet1"))
'B) write report to any wanted target
With Sheet2
.Range("A1".resize(1,4) = split("Name,Date,Day,Hours", ",")
.Range("A2").Resize(UBound(report), UBound(report, 2)) = report
End With
End Sub
帮助功能getReport()
Function getReport(ByVal employee As String, _
SourceSheet As Worksheet, _
Optional StartYear As Long = 2021, _
Optional startMonth As Long = 4)
'0) get start dates for e.g. 12 months via help function getDates()
Const MonthsCount As Long = 12
Dim datearr: datearr = getDates(DateSerial(StartYear, startMonth, 1), MonthsCount)
'1) define source range
Dim rng As Range
Set rng = SourceSheet.Range("A6").Resize(31, 3 * MonthsCount)
'2) define 1-based 2-dim report array comprising 31 x 4 elements
Dim report
ReDim report(1 To MonthsCount * 31, 1 To 4)
'3) add calculated dates and add monthly hours to report array
Dim mth As Long, d As Long, cnt As Long
For mth = 1 To MonthsCount
'get monthly hours as 2-dim array (1 column each)
Dim monthlyHours: monthlyHours = rng.Columns(mth * 3 + 2).Value
For d = 1 To ultimo(datearr(mth))
cnt = cnt + 1
report(cnt, 1) = employee
report(cnt, 2) = Application.Text(datearr(mth) + d - 1, "'m\/d") ' force date string
report(cnt, 3) = Application.Text(datearr(mth) + d - 1, "[$-409]ddd") ' force EN-US vers.
report(cnt, 4) = monthlyHours(d, 1)
Next d
Next
'4) return function result
getReport = report
End Function
帮助功能getDates()
Returns 每个月开始日期的一维数组
Function getDates(dt As Date, Optional MonthsCount As Long = 12)
'Purpose: get 1-dim array of last 12 months dates
'a) get start date
Dim EndDate As Date: EndDate = DateAdd("m", MonthsCount, dt)
Dim yrs As Long: yrs = Year(EndDate) - Year(dt)
'b) get column numbers representing a months sequence
Dim cols As String
cols = Split(Cells(, Month(dt)).Address, "$")(1)
cols = cols & ":" & Split(Cells(, Month(EndDate) - 1 + Abs(yrs * 12)).Address, "$")(1)
'c) evaluate dates
getDates = Evaluate("Date(" & Year(dt) & _
",Column(" & cols & "),1)")
End Function
帮助功能ultimo()
计算给定月份日期（范围从 28 到 31）的最后一天。
这可以使用零 (0) 作为理论日输入和函数中的最后一个参数 getSerial()
如果申请下个月（月+1）.
Function ultimo(ByVal dt) As Long
'Purp.: return last day of month
ultimo = Day(DateSerial(Year(dt), Month(dt) + 1, 0))
End Function
开发单个动态公式参考（MS 365）
"It has to be a reference - so when I change the hours in sheet1 in automatically updates in sheet2"
预先确定的固定结构让您出路
得到想要的动态参考。 “逃生路线”就是去
- 重新计算日期值（col 2-Date 和 3-Day）作为数字序列 instead 尝试引用原始日期、
- 并将所有需要的列结果作为第一步包含在
=CHOOSE({1,2,3,4},Employee,dt,dt,hours)
作为后续步骤，您需要将所有需要的列参数封装到定义所有列输入的某种公式容器 (LET()) 中，
部分参考 命名单元格 ，例如
Employee .. 例如"Bob Smith")StartDate .. 例如2021 年 4 月 1 日（此处等于 44291）StartYear .. 例如2021StartMonth.. 例如4
LET 函数（在 MS 365 中可用）允许在一个
结构化的方式也避免了一些冗余。
=LET(data,Sheet1!$C:$AL,dt,SEQUENCE(366,1,StartDate),hours,INDEX(data,DAY(dt),(MONTH(dt)+(YEAR(dt)-StartYear)*12-StartMonth)*3+3),CHOOSE({1,2,3,4},Employee,dt,dt,hours))
通过将此公式输入任何目标单元格（例如在 Sheet2 中），您将获得四列的动态 溢出范围
自动显示原始时间的变化。
提示：我将考虑 闰年 的情况留给您完善 Let 公式。
为了最终获得正确的 报告布局 用于计算的日期序列（只是数字），您必须使用所需的日期格式格式化第二和第三输出列，
例如"'m\/d" 和 "[$-409]ddd".
公式部分概览
其中包括换行以提高可读性
=LET(
data, Sheet1!$C:$AL,
dt, SEQUENCE(366,1,StartDate),
hours, INDEX(data,DAY(dt),(MONTH(dt)+(YEAR(dt)-StartYear)*12-StartMonth)*3+3),
CHOOSE({1,2,3,4},Employee,dt,dt,hours)
)
我最终使用了这个公式并且它起作用了。
firstDate = DateValue("4/1/2021")
secondDate = DateValue("4/1/2024")
n = DateDiff("d", firstDate, secondDate)
sc = Sheets.Count
scd = sc - 3
datar = "$A:$G$" & scd * n + 1
For c = sc - 1 To 3 Step -1
q = Sheets(c).Name
Sheets("Report").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Formula2R1C1 = "=SEQUENCE(DAYS(""4/1/2024"",""4/1/2021""),,""4/1/2021"")"
Sheets("Report").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Resize(n).Formula2R1C1 = "=TEXT(INDIRECT(""RC[-1]"",0),""ddd"")"
Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(n).Formula2R1C1 = Sheets(c).Range("$K")
Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Offset(-n + 1, 0).Resize(n).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & q & "'" & "!$A"
Sheets("Report").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Resize(n).Formula2R1C1 = "=INDEX(" & q & "!R6C3:R114C38,IF(LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1),LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1)-5,""""),IFERROR(MATCH(RC2,INDEX(" & q & "!R6C3:R114C38,IF(LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1),LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1)-5,""""),0),0),"""")+2)"
我有 12 个月的数据（见图一），按 Date-Jan、Day、Hours/Date-Feb、Day、Hours 等列...总共 36 列。
我正在尝试将 sheet 转换为新的 sheet 报告样式，它应该看起来是堆叠的（参见图 2），它应该有四列（员工的姓名）、日期, 日, 小时。
注意事项：
它必须是 reference - 所以当我在 中更改 sheet1 中的时间时，会自动更新 sheet2。没有复制粘贴。 （所以像例子（=b2））（不需要反转）。
如果我尝试每三列重复一次，请记住每个月都有 不同的天数，我们不希望出现空行。
我在考虑 vlookup 或索引函数，但似乎无法实现
正如@PEH 在评论中正确提到的那样，关于更改月份长度 和 没有 “完美的解决方案” 您的要求 “它必须是一个参考 - 所以当我在工作表 2 中自动更新时更改工作表 1 中的小时数”
VBA 运行-没有直接引用
(c.f. ►2nd post 开发单个动态公式参考)
由于 31 x 36 数据单元格范围的固定结构，您可以，但是
- 提供一个 包含 31*12 行 和 4 列 (Name,Date,Day,Hours) 的报告数组，
- 您填写员工姓名（第 1 列）， calculated dates（假定：字符串！）范围从 1 到最大值。 31 天（第 2 和 3 栏）， 以及 小时 从源 按列读入
- 并写回任何想要的目标。
调用示例[=62=]
根据您的需要更改工作表指示。
Sub WriteReport()
'A) create report
Dim report As Variant
report = getReport("Bob Smith", ThisWorkbook.Worksheets("Sheet1"))
'B) write report to any wanted target
With Sheet2
.Range("A1".resize(1,4) = split("Name,Date,Day,Hours", ",")
.Range("A2").Resize(UBound(report), UBound(report, 2)) = report
End With
End Sub
帮助功能getReport()
Function getReport(ByVal employee As String, _
SourceSheet As Worksheet, _
Optional StartYear As Long = 2021, _
Optional startMonth As Long = 4)
'0) get start dates for e.g. 12 months via help function getDates()
Const MonthsCount As Long = 12
Dim datearr: datearr = getDates(DateSerial(StartYear, startMonth, 1), MonthsCount)
'1) define source range
Dim rng As Range
Set rng = SourceSheet.Range("A6").Resize(31, 3 * MonthsCount)
'2) define 1-based 2-dim report array comprising 31 x 4 elements
Dim report
ReDim report(1 To MonthsCount * 31, 1 To 4)
'3) add calculated dates and add monthly hours to report array
Dim mth As Long, d As Long, cnt As Long
For mth = 1 To MonthsCount
'get monthly hours as 2-dim array (1 column each)
Dim monthlyHours: monthlyHours = rng.Columns(mth * 3 + 2).Value
For d = 1 To ultimo(datearr(mth))
cnt = cnt + 1
report(cnt, 1) = employee
report(cnt, 2) = Application.Text(datearr(mth) + d - 1, "'m\/d") ' force date string
report(cnt, 3) = Application.Text(datearr(mth) + d - 1, "[$-409]ddd") ' force EN-US vers.
report(cnt, 4) = monthlyHours(d, 1)
Next d
Next
'4) return function result
getReport = report
End Function
帮助功能getDates()
Returns 每个月开始日期的一维数组
Function getDates(dt As Date, Optional MonthsCount As Long = 12)
'Purpose: get 1-dim array of last 12 months dates
'a) get start date
Dim EndDate As Date: EndDate = DateAdd("m", MonthsCount, dt)
Dim yrs As Long: yrs = Year(EndDate) - Year(dt)
'b) get column numbers representing a months sequence
Dim cols As String
cols = Split(Cells(, Month(dt)).Address, "$")(1)
cols = cols & ":" & Split(Cells(, Month(EndDate) - 1 + Abs(yrs * 12)).Address, "$")(1)
'c) evaluate dates
getDates = Evaluate("Date(" & Year(dt) & _
",Column(" & cols & "),1)")
End Function
帮助功能ultimo()
计算给定月份日期（范围从 28 到 31）的最后一天。
这可以使用零 (0) 作为理论日输入和函数中的最后一个参数 getSerial()
如果申请下个月（月+1）.
Function ultimo(ByVal dt) As Long
'Purp.: return last day of month
ultimo = Day(DateSerial(Year(dt), Month(dt) + 1, 0))
End Function
开发单个动态公式参考（MS 365）
"It has to be a reference - so when I change the hours in sheet1 in automatically updates in sheet2"
预先确定的固定结构让您出路 得到想要的动态参考。 “逃生路线”就是去
- 重新计算日期值（col 2-Date 和 3-Day）作为数字序列 instead 尝试引用原始日期、
- 并将所有需要的列结果作为第一步包含在
=CHOOSE({1,2,3,4},Employee,dt,dt,hours)
作为后续步骤，您需要将所有需要的列参数封装到定义所有列输入的某种公式容器 (LET()) 中，
部分参考 命名单元格 ，例如
Employee.. 例如"Bob Smith")StartDate.. 例如2021 年 4 月 1 日（此处等于44291）StartYear.. 例如2021StartMonth.. 例如4
LET 函数（在 MS 365 中可用）允许在一个
结构化的方式也避免了一些冗余。
=LET(data,Sheet1!$C:$AL,dt,SEQUENCE(366,1,StartDate),hours,INDEX(data,DAY(dt),(MONTH(dt)+(YEAR(dt)-StartYear)*12-StartMonth)*3+3),CHOOSE({1,2,3,4},Employee,dt,dt,hours))
通过将此公式输入任何目标单元格（例如在 Sheet2 中），您将获得四列的动态 溢出范围
自动显示原始时间的变化。
提示：我将考虑 闰年 的情况留给您完善 Let 公式。
为了最终获得正确的 报告布局 用于计算的日期序列（只是数字），您必须使用所需的日期格式格式化第二和第三输出列，
例如"'m\/d" 和 "[$-409]ddd".
公式部分概览
其中包括换行以提高可读性
=LET(
data, Sheet1!$C:$AL,
dt, SEQUENCE(366,1,StartDate),
hours, INDEX(data,DAY(dt),(MONTH(dt)+(YEAR(dt)-StartYear)*12-StartMonth)*3+3),
CHOOSE({1,2,3,4},Employee,dt,dt,hours)
)
我最终使用了这个公式并且它起作用了。
firstDate = DateValue("4/1/2021")
secondDate = DateValue("4/1/2024")
n = DateDiff("d", firstDate, secondDate)
sc = Sheets.Count
scd = sc - 3
datar = "$A:$G$" & scd * n + 1
For c = sc - 1 To 3 Step -1
q = Sheets(c).Name
Sheets("Report").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Formula2R1C1 = "=SEQUENCE(DAYS(""4/1/2024"",""4/1/2021""),,""4/1/2021"")"
Sheets("Report").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Resize(n).Formula2R1C1 = "=TEXT(INDIRECT(""RC[-1]"",0),""ddd"")"
Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(n).Formula2R1C1 = Sheets(c).Range("$K")
Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Offset(-n + 1, 0).Resize(n).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & q & "'" & "!$A"
Sheets("Report").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Resize(n).Formula2R1C1 = "=INDEX(" & q & "!R6C3:R114C38,IF(LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1),LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1)-5,""""),IFERROR(MATCH(RC2,INDEX(" & q & "!R6C3:R114C38,IF(LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1),LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1)-5,""""),0),0),"""")+2)"