้亮点将于 6 个月后过期

Question

仅突出显示第 1-30 天（未来 6 个月内），否则不要显示其他内容，以确认搜索将在未来 6 个月内过期的产品时的绳索完整性。

我有一个例子。但直到该月 30 日才能突出显示。

Sub test()
 Dim ws As Worksheet
    Dim lastRow As Long
    Dim todayDate As Date
    Dim sixMonthsLater As Date
    Dim expiryColumn As Range
    Dim cell As Range
    
    ' Set the worksheet object to the desired worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' Replace "Sheet1" with your sheet name
    
    ' Get the last row in the worksheet
    lastRow = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row
    
    ' Set the expiry column range
    Set expiryColumn = ws.Range("N2:N" & lastRow)
    
    ' Get the current date
    todayDate = Date
    
    ' Calculate the date six months later
    sixMonthsLater = DateAdd("m", 6, todayDate)
    
    ' Loop through the cells in the expiry column
    For Each cell In expiryColumn
        ' Check if the expiry date is within the next 6 months and the month is the 6th month
        If cell.Value > todayDate And cell.Value <= sixMonthsLater And Month(cell.Value) = Month(sixMonthsLater) Then
            ' Apply formatting to the cell
            cell.EntireRow.Interior.Color = RGB(255, 127, 80) ' Orange color
        End If
    Next cell
End Sub

Answer 1

• 获取目标月份的第一天和最后一天

Option Explicit
Sub test()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim todayDate As Date
    Dim sixMonthsLater As Date
    Dim expiryColumn As Range
    Dim cell As Range
    ' Set the worksheet object to the desired worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' Replace "Sheet1" with your sheet name
    ' Get the last row in the worksheet
    lastRow = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row
    ' Set the expiry column range
    Set expiryColumn = ws.Range("N2:N" & lastRow)
    ' Get the current date
    todayDate = Date
    Dim Yr As Long, Mth As Long
    Dim StartDay As Date, EndDay As Date
    ' Calculate the date six months later
    sixMonthsLater = DateAdd("m", 6, todayDate)
    Yr = Year(sixMonthsLater)
    Mth = Month(sixMonthsLater)
    StartDay = DateSerial(Yr, Mth, 1)
    EndDay = DateSerial(Yr, Mth + 1, 0)
    ' Loop through the cells in the expiry column
    For Each cell In expiryColumn
        ' Check if the expiry date is within the next 6 months and the month is the 6th month
        If cell.Value >= StartDay And cell.Value <= EndDay Then
            ' Apply formatting to the cell
            cell.EntireRow.Interior.Color = RGB(255, 127, 80) ' Orange color
        End If
    Next cell
End Sub