如何添加即将到来的时期 Excel/VBA

Question

我有以下测试数据集：

Product	Period	Cost	End date
A	01-01-2022	100	01-01-2023
B	01-01-2022	75	01-01-2024
C	01-01-2022	290	01-05-2023

我想用 Excel 或 VBA 创建以下内容：用即将到来的时期（如预测）丰富数据集，直到结束日期，成本相同。它不必按特定的时间顺序排列，但输出应该是这样的：

Product	Period	Cost	End date
A	01-01-2022	100	01-01-2023
A	01-02-2022	100	01-01-2023
A	01-03-2022	100	01-01-2023
A	01-04-2022	100	01-01-2023
A	01-05-2022	100	01-01-2023
A	01-06-2022	100	01-01-2023
A	01-07-2022	100	01-01-2023
A	01-08-2022	100	01-01-2023
A	01-09-2022	100	01-01-2023
A	01-10-2022	100	01-01-2023
A	01-11-2022	100	01-01-2023
A	01-12-2022	100	01-01-2023
B	01-01-2022	75	01-01-2024
B	01-01-2022	75	01-01-2024
B	01-02-2022	75	01-01-2024
B	01-03-2022	75	01-01-2024
B	01-04-2022	75	01-01-2024
B	01-05-2022	75	01-01-2024
B	01-06-2022	75	01-01-2024
B	01-07-2022	75	01-01-2024
B	01-08-2022	75	01-01-2024
B	01-09-2022	75	01-01-2024
B	01-10-2022	75	01-01-2024
B	01-11-2022	75	01-01-2024
B	01-12-2022	75	01-01-2024
B	01-01-2023	75	01-01-2024
B	01-01-2023	75	01-01-2024
B	01-02-2023	75	01-01-2024
B	01-03-2023	75	01-01-2024
B	01-04-2023	75	01-01-2024
B	01-05-2023	75	01-01-2024
B	01-06-2023	75	01-01-2024
B	01-07-2023	75	01-01-2024
B	01-08-2023	75	01-01-2024
B	01-09-2023	75	01-01-2024
B	01-10-2023	75	01-01-2024
B	01-11-2023	75	01-01-2024
B	01-12-2023	75	01-01-2024
C	01-01-2022	290	01-05-2023
C	01-02-2022	290	01-05-2023
C	01-03-2022	290	01-05-2023
C	01-04-2022	290	01-05-2023
C	01-05-2022	290	01-05-2023
C	01-06-2022	290	01-05-2023
C	01-07-2022	290	01-05-2023
C	01-08-2022	290	01-05-2023
C	01-09-2022	290	01-05-2023
C	01-10-2022	290	01-05-2023
C	01-11-2022	290	01-05-2023
C	01-12-2022	290	01-05-2023
C	01-01-2023	290	01-05-2023
C	01-02-2023	290	01-05-2023
C	01-03-2023	290	01-05-2023
C	01-04-2023	290	01-05-2023

如何在 Excel 中完成这项工作？有什么建议么？

Answer 1

尝试：

F1 中的公式：

=LET(a,DATEDIF(B2:B4,D2:D4,"m"),b,SCAN(0,a,LAMBDA(X,Y,X+Y)),c,SEQUENCE(SUM(a)),d,INDEX(A2:D4,XMATCH(c,b,1),{1,2,3,4}),e,SCAN(EOMONTH(B2,-1),c,LAMBDA(f,g,IF(INDEX(d,MAX(g-1,1),1)=INDEX(d,g,1),EOMONTH(f,0)+1,INDEX(d,g,2)))),VSTACK(A1:D1,CHOOSECOLS(HSTACK(d,e),{1,5,3,4})))

Answer 2

请尝试下一个代码。它创建一个由结束日期和期间之间的差异计算的月份间隔数组，然后将其放置在新创建的工作表（“预测”）的正确位置。如果这张表已经存在（第二次运行代码时），它只会被清除。该代码将处理 A:A 列中存在的所有产品。它应该适用于所有 Excel 版本：

Sub MakeForecast()
  Dim sh As Worksheet, shF As Worksheet, lastR As Long, arrHead, arr, arrD, i As Long
  
  Set sh = ActiveSheet
  If sh.name = "Forecast" Then MsgBox "You activated a wrong sheet...": End Sub 'for the case of activating it by mistake
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  arrHead = sh.Range("A1:D1").Value
  arr = sh.Range("A2:D" & lastR).Value2
  
  On Error Resume Next
    Set shF = Worksheets("Forecast") 'check if "Forecast" sheet is already created
  On Error GoTo 0
  If shF Is Nothing Then   'if not, create it and name "Forecast"
        Set shF = Worksheets.Add(After:=sh)
        shF.name = "Forecast"
  Else
        shF.cells.Clear    'if created, clear all its cells contents
  End If
  For i = 1 To UBound(arr) 'iterate between the array rows
        arrD = makeMonthsDateRange(CDate(arr(i, 2)), CDate(arr(i, 4))) 'use the function to create the moths array
        createProdRange shF, arrD, CStr(arr(i, 1)), CDbl(arr(i, 3)), CDate(arr(i, 4)), IIf(i = 1, arrHead, Array("")) 'drop the array content and format a little
  Next i
  shF.Columns("A:D").EntireColumn.AutoFit
  MsgBox "Ready..."
End Sub

Private Function makeMonthsDateRange(frstD As Date, lastD As Date) As Variant
     Dim countD As Long, arrM
     countD = DateDiff("m", frstD, lastD, vbMonday)
     makeMonthsDateRange = Evaluate("DATE(" & Year(frstD) & ",ROW(1:" & countD & "),1)")
End Function

Sub createProdRange(ws As Worksheet, arrMonths, strProduct As String, cost As Double, endDate As Date, arrH)
   If UBound(arrH) > 0 Then ws.Range("A1").Resize(1, UBound(arrH, 2)).Value = arrH
    Dim lastR As Long: lastR = ws.Range("A" & ws.rows.count).End(xlUp).row + 1
    With ws.Range("A" & lastR, "D" & UBound(arrMonths) + lastR - 1)
        .Columns(1).Value = strProduct
         With .Columns(2)
            .Value2 = arrMonths
            .NumberFormat = "dd-mm-yyy"
         End With
         .Columns(3).Value2 = cost
         With .Columns(4)
            .Value2 = endDate
            .NumberFormat = "dd-mm-yyy"
         End With
    End With
End Sub

请在测试后发送一些反馈。如果有什么不够清楚，请不要犹豫，要求澄清。