如何将日期区间内各季度天数拆分至对应Excel列？

工作表情况 #

工作表需根据起始日期（如B列）和结束日期（如C列），将区间内的天数拆分到对应年份季度的绿色列中。目前已实现自定义函数GetDayPerQtr，可输出各季度天数的字符串结果（示例见D4单元格），运行正常。

现有自定义函数代码 #

Function GetDayPerQtr(ReimDt As Date, HoldDt As Date) As String
    Dim Qtr As Integer
    Dim QtrStDt As Date
    Dim QtrEndDate As Date
    Dim TotalQtrs As Long
    Dim tmp As String
    Dim i As Long
    
    Qtr = DetermineQuarter(ReimDt)
    QtrEndDate = DateSerial(Year(ReimDt), (Qtr * 3) + 1, 0)
    
    If QtrEndDate <= HoldDt Then
        TotalQtrs = DateDiff("q", ReimDt, HoldDt)
        
        If TotalQtrs > 1 Then
            QtrStDt = ReimDt
            
            For i = 1 To TotalQtrs
                Qtr = DetermineQuarter(QtrStDt)
                If Qtr = 2 Or Qtr = 3 Then
                    QtrEndDate = DateSerial(Year(QtrStDt), Qtr * 3, 30)
                Else
                    QtrEndDate = DateSerial(Year(QtrStDt), Qtr * 3, 31)
                End If
                
                tmp = tmp & ", " & (QtrEndDate - QtrStDt + 1)
                QtrStDt = QtrEndDate + 1
            Next i
            
            tmp = tmp & ", " & (HoldDt - QtrStDt + 1)
            tmp = Mid(tmp, 2)
        Else
            tmp = QtrEndDate - ReimDt
            QtrStDt = QtrEndDate + 1
            tmp = tmp & ", " & (HoldDt - QtrStDt + 1)
        End If
    Else
        tmp = HoldDt - ReimDt
    End If
    
    GetDayPerQtr = tmp
End Function

Function DetermineQuarter(Dt As Date) As Integer
    Dim inputDate As Date
    Dim quarter As Integer
    Dim inputMonth As Integer
    
    inputDate = Dt
    inputMonth = Month(inputDate)
    
    If inputMonth >= 1 And inputMonth <= 3 Then
        quarter = 1
    ElseIf inputMonth >= 4 And inputMonth <= 6 Then
        quarter = 2
    ElseIf inputMonth >= 7 And inputMonth <= 9 Then
        quarter = 3
    ElseIf inputMonth >= 10 And inputMonth <= 12 Then
        quarter = 4
    End If
    DetermineQuarter = quarter
End Function

需求说明 #

需将GetDayPerQtr输出的各季度天数，精准分配到对应年份季度的列中（如2020年Q1、2020年Q2等绿色单元格）。尝试编写GetTotalDaysInQtr函数（函数模板如下）但遇到瓶颈，寻求可行的VBA或Excel公式解决方案。

'=GetTotalDaysInQtr("Q1",2020,B4,C4)
Function GetTotalDaysInQtr(Qtr As String, Yr As Long, ReimDt As Date, HoldDt As Date) As Long

End Function

解决方案 #

方案1：完善VBA自定义函数GetTotalDaysInQtr #

以下是实现该函数的完整代码，可直接返回指定季度年份在日期区间内的天数：

'=GetTotalDaysInQtr("Q1",2020,B4,C4)
Function GetTotalDaysInQtr(Qtr As String, Yr As Long, ReimDt As Date, HoldDt As Date) As Long
    Dim qtrNum As Integer
    Dim qtrStart As Date
    Dim qtrEnd As Date
    Dim periodStart As Date
    Dim periodEnd As Date
    
    ' 提取季度数字
    qtrNum = CInt(Right(Qtr, 1))
    
    ' 计算指定季度的起止日期
    qtrStart = DateSerial(Yr, (qtrNum - 1) * 3 + 1, 1)
    Select Case qtrNum
        Case 1, 4
            qtrEnd = DateSerial(Yr, qtrNum * 3, 31)
        Case 2, 3
            qtrEnd = DateSerial(Yr, qtrNum * 3, 30)
    End Select
    
    ' 确定区间重叠部分的起止
    periodStart = IIf(ReimDt > qtrStart, ReimDt, qtrStart)
    periodEnd = IIf(HoldDt < qtrEnd, HoldDt, qtrEnd)
    
    ' 计算重叠天数，若无重叠则返回0
    If periodStart > periodEnd Then
        GetTotalDaysInQtr = 0
    Else
        GetTotalDaysInQtr = periodEnd - periodStart + 1
    End If
End Function

使用示例：若要计算2020年Q1在B4（起始日期）和C4（结束日期）区间内的天数，直接输入公式=GetTotalDaysInQtr("Q1",2020,B4,C4)即可。

方案2：Excel公式实现（无需VBA） #

可以直接用Excel内置函数组合计算指定季度的天数，以2020年Q1为例，公式如下：

=MAX(0,MIN(C4,DATE(2020,3,31))-MAX(B4,DATE(2020,1,1))+1)

• 替换公式中的2020,3,31为对应季度的结束日期（Q2是2020,6,30，Q3是2020,9,30，Q4是2020,12,31）
• 替换2020,1,1为对应季度的起始日期（Q2是2020,4,1，Q3是2020,7,1，Q4是2020,10,1）
• 若区间与该季度无重叠，公式会返回0

内容的提问来源于stack exchange，提问作者Dhruva