如何基于输入日期获取季度末日期并生成10年季度序列？

现有代码说明 #

你当前的VBA代码可识别指定单元格日期所属的季度（T1-T4），代码如下：

Sub Trimestre()
    If Month(Sheets("Paramétrage").Cells(3, 3).Value) >= 1 And _
       Month(Sheets("Paramétrage").Cells(3, 3).Value) <= 3 Then
        Sheets("Paramétrage").Cells(12, 1).Value = "T1"
    End If

    If Month(Sheets("Paramétrage").Cells(3, 3).Value) > 3 And _
       Month(Sheets("Paramétrage").Cells(3, 3).Value) <= 6 Then
        Sheets("Paramétrage").Cells(12, 1).Value = "T2"
    End If

    If Month(Sheets("Paramétrage").Cells(3, 3).Value) > 6 And _
       Month(Sheets("Paramétrage").Cells(3, 3).Value) <= 9 Then
        Sheets("Paramétrage").Cells(12, 1).Value = "T3"
    End If

    If Month(Sheets("Paramétrage").Cells(3, 3).Value) > 9 And _
       Month(Sheets("Paramétrage").Cells(3, 3).Value) <= 12 Then
        Sheets("Paramétrage").Cells(12, 1).Value = "T4"
    End If
End Sub

功能扩展实现 #

以下是满足你两个需求的完整代码：

核心功能说明 #

1. 计算季度最后一天：利用DateSerial函数的特性，将月份设为下一季度首月、日期设为0，自动返回当前季度最后一天，无需手动判断每月天数。
2. 生成10年季度信息：从输入日期所属季度开始，循环生成后续40个季度（10年×4个季度）的标识、起止日期，输出到指定区域。

Sub TrimestreExtended()
    Dim inputDate As Date
    Dim currentQuarter As Integer
    Dim quarterLastDay As Date
    Dim outputRow As Integer
    Dim i As Integer
    
    ' 获取输入日期（Paramétrage表C3单元格）
    inputDate = Sheets("Paramétrage").Cells(3, 3).Value
    
    ' 简化版季度判断
    currentQuarter = Int((Month(inputDate) - 1) / 3) + 1
    Sheets("Paramétrage").Cells(12, 1).Value = "T" & currentQuarter
    
    ' 计算当前季度最后一天，输出到B12
    quarterLastDay = DateSerial(Year(inputDate), 3 * currentQuarter + 1, 0)
    Sheets("Paramétrage").Cells(12, 2).Value = quarterLastDay
    Sheets("Paramétrage").Cells(12, 2).NumberFormat = "yyyy-mm-dd"
    
    ' 生成后续10年季度信息，从A14开始输出表头
    outputRow = 14
    Sheets("Paramétrage").Cells(outputRow - 1, 1).Value = "季度标识"
    Sheets("Paramétrage").Cells(outputRow - 1, 2).Value = "季度开始日"
    Sheets("Paramétrage").Cells(outputRow - 1, 3).Value = "季度结束日"
    
    ' 循环生成40个季度的信息
    For i = 0 To 39
        Dim targetYear As Integer
        Dim targetQuarter As Integer
        Dim quarterStart As Date
        
        ' 计算目标季度的年份和季度数
        targetYear = Year(inputDate) + Int((currentQuarter + i - 1) / 4)
        targetQuarter = ((currentQuarter + i - 1) Mod 4) + 1
        
        ' 推导季度起止日期
        quarterStart = DateSerial(targetYear, 3 * (targetQuarter - 1) + 1, 1)
        quarterLastDay = DateSerial(targetYear, 3 * targetQuarter + 1, 0)
        
        ' 输出数据并设置格式
        Sheets("Paramétrage").Cells(outputRow + i, 1).Value = "T" & targetQuarter & " " & targetYear
        Sheets("Paramétrage").Cells(outputRow + i, 2).Value = quarterStart
        Sheets("Paramétrage").Cells(outputRow + i, 3).Value = quarterLastDay
        Sheets("Paramétrage").Cells(outputRow + i, 2).NumberFormat = "yyyy-mm-dd"
        Sheets("Paramétrage").Cells(outputRow + i, 3).NumberFormat = "yyyy-mm-dd"
    Next i
End Sub

代码优化点 #

• 用Int((Month(inputDate) - 1) / 3) + 1替代原有的多段If判断，简化季度计算逻辑
• 统一设置日期显示格式，避免系统默认格式混乱
• 循环逻辑确保完整覆盖输入日期之后的10年周期，无遗漏或重复季度

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