求VBA代码：获取Excel D列今日或最近未来日期的首行号

需求说明 #

在Excel的D列中存在非连续、可能无序的日期数据，需要实现以下逻辑：

• 找到首个与当日日期完全匹配的单元格行号，存入变量todayrow
• 若当日日期不存在于D列，则返回首个最近的未来日期对应的行号
• 忽略所有过去的日期

VBA代码实现 #

Sub GetTargetDateRow()
    Dim targetSheet As Worksheet
    Dim lastDataRow As Long
    Dim currentDate As Date
    Dim todayrow As Long
    Dim loopIndex As Long
    Dim nearestFutureDate As Date
    Dim nearestFutureRow As Long
    
    ' 替换为你的目标工作表名称
    Set targetSheet = ThisWorkbook.Worksheets("Sheet1")
    ' 获取D列最后一行数据的行号
    lastDataRow = targetSheet.Cells(targetSheet.Rows.Count, "D").End(xlUp).Row
    ' 获取当日日期（仅保留日期部分，排除时间）
    currentDate = Date
    
    ' 初始化变量
    todayrow = 0
    ' 设置一个极大的初始日期，确保后续能找到更小的未来日期
    nearestFutureDate = DateSerial(9999, 12, 31)
    nearestFutureRow = 0
    
    ' 遍历D列所有日期行
    For loopIndex = 1 To lastDataRow
        ' 仅处理单元格为日期格式的情况
        If IsDate(targetSheet.Cells(loopIndex, "D").Value) Then
            Dim cellDate As Date
            cellDate = DateValue(targetSheet.Cells(loopIndex, "D").Value)
            
            ' 找到首个当日日期，直接赋值并退出循环
            If cellDate = currentDate Then
                todayrow = loopIndex
                Exit For
            ' 筛选未来日期，记录最小日期的首个行号
            ElseIf cellDate > currentDate Then
                If cellDate < nearestFutureDate Then
                    nearestFutureDate = cellDate
                    nearestFutureRow = loopIndex
                End If
            End If
        End If
    Next loopIndex
    
    ' 若未找到当日日期，使用最近未来日期的行号
    If todayrow = 0 Then
        todayrow = nearestFutureRow
    End If
    
    ' 此处可根据需求修改结果的使用方式，比如写入单元格或后续逻辑
    ' 示例：输出结果到消息框
    MsgBox "目标行号：" & todayrow
End Sub

代码逻辑解释 #

1. 范围初始化：指定操作的工作表，获取D列最后一行的行号，避免遍历空单元格提升效率
2. 日期标准化：使用Date获取系统当日日期，DateValue提取单元格的纯日期部分，避免时间格式干扰匹配
3. 遍历匹配：
   • 优先匹配当日日期，找到第一个匹配项后立即退出循环，保证返回的是首个匹配行
   • 对未来日期，始终记录当前找到的最小日期对应的行号，确保最终得到的是最近的未来日期的首个出现行
4. 结果赋值：如果未找到当日日期，自动将最近未来日期的行号赋值给todayrow

示例验证 #

针对你提供的示例数据：

• 当当日为2023年2月28日：遍历后无当日匹配，未来日期中最小的是03-Mar-23，其首个行号为5，因此todayrow=5
• 当当日为2023年2月27日：遍历到第2行时匹配当日日期，直接赋值todayrow=2并终止循环，符合需求

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