正如@PEH 在评论中正确提到的那样，对于更改月份长度和您的要求没有“整洁的解决方案”“它必须是一个参考 - 所以当我在 sheet2 中自动更新 sheet1 中的小时数时"
没有直接引用的 VBA 启动
（c.f. ►2nd post developmenting a single dynamic formula reference）
由于您的 31 x 36 数据单元范围的固定结构，您可以，但是
- 提供一个
具有 31*12 行 和 4 列 (Name,Date,Day,Hours) 的报告数组，
- 您填写员工姓名 (col.1)，
计算的 日期（假设：字符串！）范围从 1 到最大值。 31 天（第 2 栏和第 3 栏），
以及从源中按列读取的小时
- 并写回任何想要的目标。
调用示例
根据您的需要更改工作表指示。
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()
返回每个月开始日期的 1-dim 数组
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