如何用VBA匹配今日所在周对应日期范围中的单元格？

• Excel里第5行是隐藏的日期行，没法用FIND函数
• 今天是8月13日，要找到和今天同周的日期单元格（示例里是对应8月15日的D5）
• 试了一段VBA代码没成功，优先不想用周数辅助行，实在不行也能接受

原测试代码：

Dim rngFound As Range
Dim TodaysWeek As Integer

    TodaysWeek = Application.WorksheetFunction.WeekNum(Date, vbMonday)
    
    Set rngFound = .Cells(Application.WorksheetFunction.Match(TodaysWeek, Application.worksheetfunktion.WeekNum(DateRange, vbMonday), 0))

1. 拼写错误：Application.worksheetfunktion应该是Application.WorksheetFunction（注意大小写和拼写）
2. WeekNum函数不能直接作用于单元格区域DateRange，WorksheetFunction的函数大多不支持直接对区域做数组运算，会直接报错
3. .Cells引用没指定行号，得明确指向第5行的单元格

直接遍历第5行的隐藏单元格，逐个判断日期是否和今天同周（以周一为一周起点）：

Sub FindSameWeekDate()
    Dim targetRow As Integer
    Dim cell As Range
    Dim todayDate As Date
    Dim todayWeekStart As Date
    Dim cellWeekStart As Date
    
    targetRow = 5 '目标日期行
    todayDate = Date '当前日期，示例为8月13日
    
    '算出今天所在周的周一（作为周的唯一标识）
    todayWeekStart = todayDate - Weekday(todayDate, vbMonday) + 1
    
    '遍历第5行的单元格（可根据实际列范围调整，这里假设是A到Z列）
    For Each cell In ThisWorkbook.ActiveSheet.Rows(targetRow).Columns("A:Z").Cells
        '跳过空单元格和非日期内容
        If Not IsEmpty(cell.Value) And IsDate(cell.Value) Then
            '算出当前单元格日期所在周的周一
            cellWeekStart = cell.Value - Weekday(cell.Value, vbMonday) + 1
            '判断是否属于同一周
            If cellWeekStart = todayWeekStart Then
                Set rngFound = cell '找到目标单元格
                Debug.Print "找到目标单元格：" & cell.Address
                Exit For '找到后直接退出循环，不用继续遍历
            End If
        End If
    Next cell
End Sub

• 核心思路：用每周的周一作为周的判断标准，避免WeekNum函数跨年时的周数混乱问题
• 单元格所在行隐藏不影响遍历操作，照样能读取到单元格值

如果表格列数特别多，遍历效率太低，可以临时插一行辅助行计算周数，定位完成后再删掉辅助行：

Sub FindSameWeekWithHelperRow()
    Dim targetRow As Integer
    Dim helperRow As Integer
    Dim todayWeek As Integer
    Dim matchCol As Integer
    
    targetRow = 5
    helperRow = targetRow + 1 '在日期行下面插辅助行
    
    '插入辅助行
    Rows(helperRow).Insert
    todayWeek = Application.WorksheetFunction.WeekNum(Date, vbMonday)
    
    '给辅助行批量设置周数公式（假设日期列是A到Z）
    ThisWorkbook.ActiveSheet.Range("A" & helperRow & ":Z" & helperRow).Formula = _
        "=WEEKNUM(A" & targetRow & ",2)" '参数2代表周一为周起始
    
    '匹配对应周数的列
    On Error Resume Next '处理找不到的情况
    matchCol = Application.WorksheetFunction.Match(todayWeek, Range("A" & helperRow & ":Z" & helperRow), 0)
    On Error GoTo 0
    
    If matchCol > 0 Then
        Set rngFound = ThisWorkbook.ActiveSheet.Cells(targetRow, matchCol)
        Debug.Print "找到目标单元格：" & rngFound.Address
    End If
    
    '删除辅助行（也可以设置隐藏保留）
    Rows(helperRow).Delete
End Sub

• 适合列数极多的场景，计算速度更快
• 辅助行只是临时存在，不会破坏原有表格结构

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