VBA代码修正：高亮未来6个月内最后一月1-30日到期的产品

原代码存在两个核心问题，导致无法正确覆盖到目标月份的30日：

1. sixMonthsLater 是当前日期直接加6个月的结果（比如今天是5/15，得到11/15），这会把到期日的范围限制到该日期，而非当月30日
2. 仅通过月份匹配判断，但没有明确限定日期必须在当月1日至30日之间

以下是修正后的代码：

Sub HighlightExpiringProducts()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim todayDate As Date
    Dim targetMonthStart As Date
    Dim targetMonthEnd As Date
    Dim expiryColumn As Range
    Dim cell As Range
    
    ' 指定要操作的工作表，替换为你的实际表名
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 获取到期日列（N列）的最后一行
    lastRow = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row
    Set expiryColumn = ws.Range("N2:N" & lastRow)
    
    todayDate = Date
    
    ' 计算未来6个月后对应月份的第一天（目标周期的最后一个月起始）
    targetMonthStart = DateSerial(Year(DateAdd("m", 6, todayDate)), Month(DateAdd("m", 6, todayDate)), 1)
    ' 计算目标月份的30日（严格匹配需求的结束日期）
    targetMonthEnd = DateSerial(Year(targetMonthStart), Month(targetMonthStart), 30)
    
    ' 先清除之前的高亮格式，避免残留错误标记
    ws.Range("2:" & lastRow).Interior.ColorIndex = xlColorIndexNone
    
    ' 遍历所有到期日单元格
    For Each cell In expiryColumn
        ' 先判断单元格是否为有效日期，避免非日期值引发错误
        If IsDate(cell.Value) Then
            ' 检查到期日是否满足：在今天之后，且处于目标月份的1日至30日之间
            If cell.Value > todayDate And cell.Value >= targetMonthStart And cell.Value <= targetMonthEnd Then
                ' 为整行设置橙色高亮
                cell.EntireRow.Interior.Color = RGB(255, 127, 80)
            End If
        End If
    Next cell
End Sub

关键修改说明 #

• 精准锁定目标日期范围：
  • 用DateSerial直接生成未来6个月后月份的1日和30日，彻底解决原代码中日期范围截断的问题
• 增加有效性校验：
  • 加入IsDate(cell.Value)判断，防止非日期格式的单元格导致代码报错
• 优化格式管理：
  • 在遍历前清除历史高亮，确保每次运行结果都是最新的匹配情况

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