填充两个日期之间的所有月份

Question

我一直在尝试在 Excel 中创建一个公式来填充两个日期之间的月份。

我得到的只是 DatedIF() 但它不满足要求。

这是我想要的 Excel 公式中的图片。如果我更新开始日期或结束日期公式中的任何日期，将自动计算日期之间的所有月份，并在附图中给出结果。

代码结果和我想要的结果。代码应该与日期相应地工作。

https://docs.google.com/spreadsheets/d/1AbLs8soPOgQvorwIzWLIJIooIQiVg9fvKaBdxY0tmgU/edit#gid=1340167497

=IF(ROW()=15,0,IFERROR(INDEX(MONTH(EDATE(Sheet1!B$4,ROW(A$15:INDEX(A:A,DATEDIF(Sheet1!B$4,Sheet1!G$1,"m"))))),COUNT(A$15:A15)),""))

Answer 1

你可以试试：

A4中的公式：

=IF(ROW()=4,0,IFERROR(INDEX(MONTH(EDATE(B$1,ROW(A$1:INDEX(A:A,DATEDIF(B$1,B$2,"m"))))),COUNT(A$3:A3)),""))

向下拖动。

注意：例如，结束日期为“30-12-2021”时，最多只能显示 11 个。如果您仍希望看到最多 12 个，则需要使用 EOMONTH() 作为里面有一个嵌套函数。

Answer 2

这将从第 5 行开始填充。毫无疑问，该代码可以用作数组公式。

Sub Test()

    With ThisWorkbook.Worksheets("Sheet1")
        PopulateMonths .Range("B2"), .Range("B3")
    End With

End Sub

Sub PopulateMonths(FirstDate As Range, SecondDate As Range)

    Dim MonthCount As Long
    MonthCount = DateDiff("m", FirstDate, SecondDate)
    
    With ThisWorkbook.Worksheets("Sheet1")
    
        'This will clear from row 5, column 1 to the last piece of data in column 1.
        'If column 1 is already empty it will clear from A1:A5, so best to check if
        'there's any data to clear before this line runs (just see if A5<>"")
        .Range(.Cells(5, 1), .Cells(.Rows.Count, 1).End(xlUp)).ClearContents
    
        Dim x As Long
        For x = 0 To MonthCount
            .Cells(x + 5, 1) = x 'Start on row 5, column 1.
        Next x
    
    End With
    
End Sub

Answer 3

填充两个日期之间的月份

• 以下是使用Worksheet Change event 的自动版本，即它仅在您手动或通过VBA 更改值（而不是通过公式）时运行。您无需运行任何东西，只需将代码复制到相应的模块并调整常量部分中的值即可。
• 如果出于某种原因不想自动化，可以删除sheet模块中的代码，删除标准模块中Option Explicit下面的三个常量，取消populateMonths中三个常量的注释。现在它只适用于populateMonthsInit。
• 如果开始日期是该月的最后一天，则该月将不包括在内。同样，如果结束日期是该月的第一个日期，则该月将不包括在内。这很容易调整。

表格模块，例如Sheet1

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Set rng = Intersect(Union(Range(StartDateCell), Range(EndDateCell)), Target)
    If Not rng Is Nothing Then
        populateMonths
    End If
End Sub

标准模块，例如Module1

Option Explicit
 
Public Const StartDateCell As String = "B1"
Public Const EndDateCell As String = "B2"
Private Const FirstCell As String = "B4"

Sub populateMonthsInit()
    populateMonths
End Sub

Sub populateMonths(Optional ws As Worksheet)
    'Const StartDateCell As String = "B1"
    'Const EndDateCell As String = "B2"
    'Const FirstCell As String = "B4"
    If ws Is Nothing Then
        Set ws = ThisWorkbook.ActiveSheet
    End If
    With ws.Range(FirstCell)
        Dim Data As Variant
        Data = getMonthNumbers(.Worksheet.Range(StartDateCell).Value, _
            .Worksheet.Range(EndDateCell).Value)
        .Resize(.Worksheet.Rows.Count - .Row + 1).ClearContents
        .Value = 0 ' Not sure what that's all about.
        If Not IsEmpty(Data) then
            .Offset(1).Resize(UBound(Data, 1)).Value = Data
        End if
    End With
End Sub

Function getMonthNumbers( _
    ByVal StartDate As Date, _
    ByVal EndDate As Date) _
As Variant
    On Error GoTo clearError
    Dim Months As Long: Months = DateDiff("m", StartDate, EndDate)
    Dim StartMonth As Long
    If Month(StartDate + 1) = Month(StartDate) Then
        Months = Months + 1
        StartMonth = modMonth(Month(StartDate))
    Else
        StartMonth = modMonth(Month(StartDate) + 1)
    End If
    If Month(EndDate - 1) <> Month(EndDate) Then
        Months = Months - 1
    End If
    Dim Data() As Long: ReDim Data(1 To Months, 1 To 1)
    Data(1, 1) = StartMonth
    Dim i As Long
    For i = 2 To Months
        Data(i, 1) = modMonth(Data(i - 1, 1) + 1)
    Next i
    getMonthNumbers = Data
ProcExit:
    Exit Function
clearError:
    Resume ProcExit
End Function

Function modMonth( _
    m As Long) _
As Long
    modMonth = IIf(m Mod 12, m Mod 12, 12)
End Function

Sub TESTgetMonthNumbers()
    Dim Data As Variant: Data = getMonthNumbers(Range("B1"), Range("B2"))
    If Not IsEmpty(Data) Then
        Debug.Print Join(Application.Transpose(Data), vbLf)
    Else
        Debug.Print "Nope."
    End If
End Sub