Excel打开工作簿如何自动定位跳转至当日日期所在单元格

你原有代码存在4个核心问题，会导致功能无法正常运行：

• 工作表引用不一致：代码先选中Sheet1，后续查找日期却在Sheet2的第2行执行，和你描述的「日期按行排布、每行对应当日日程」的表结构不匹配
• 查找逻辑有漏洞：仅用Day(Date)提取当日的“日”数字做匹配，不同月份同一天的日值完全相同，会匹配到错误日期；且查找范围限定在第2行，不符合整列存储日期的结构
• 方法调用错误：VBA的Range对象不存在.Show方法，无法通过该方法实现窗口滚动
• 变量未规范声明：变量x未提前定义类型，容易触发类型匹配错误

正确操作步骤 #

1. 打开目标工作簿，按Alt+F11快捷键调出VBA编辑器
2. 在左侧工程资源管理器面板中双击ThisWorkbook模块，清空原有错误代码，粘贴下方修正后的代码
3. 将文件保存为.xlsm（启用宏的工作簿）格式，后续打开文件时选择启用宏即可自动触发定位

Private Sub Workbook_Open()
    Dim targetSht As Worksheet
    Dim dateCol As Range
    Dim todayDate As Date
    Dim CellToShow As Range
    
    ' 按需修改：引号内改为你存储日期和日程的实际工作表名称
    Set targetSht = ThisWorkbook.Worksheets("Sheet1")
    todayDate = VBA.Date
    
    Application.ScreenUpdating = False
    targetSht.Select
    
    ' 按需修改：Range("A:A")代表在A列查找日期，如果你的日期存在其他列，修改对应列标即可
    Set dateCol = targetSht.Range("A:A")
    Set CellToShow = dateCol.Find( _
        What:=todayDate, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        MatchCase:=False _
    )
    
    If CellToShow Is Nothing Then
        MsgBox "未找到今日日期对应单元格，请检查日期列是否为标准日期格式", vbCritical
    Else
        CellToShow.Select
        ' 滚动窗口，让目标单元格显示在窗口顶部区域
        ActiveWindow.ScrollRow = CellToShow.Row
    End If
    
    Application.ScreenUpdating = True
End Sub

使用说明 #

• 如果日期存储在非A列，只需要修改代码中Range("A:A")的列标为实际列即可，比如日期在B列就改为Range("B:B")
• 日期列需要存储为Excel标准日期格式，不要存为文本字符串，否则会出现查找失败的问题
• 宏安全设置会影响代码运行，打开文件时需要在顶部安全警告栏选择「启用内容」

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