新手求助：VBA代码无法运行，需在外部工作簿搜索今日日期

嘿，作为VBA新手碰到代码跑不起来太正常啦，我帮你梳理下原代码的问题，再给你改好能用的版本，刚好实现你要的「从另一个工作簿搜索今日日期」的需求～

原代码的几个问题 #

• Sub定义错误：Sub Sample 必须加上括号，写成 Sub Sample()，否则语法不通过
• 变量声明位置不对：变量声明（Dim...）必须放在Sub过程的最开头，不能在Sheets("Database").Select之后
• 过度依赖Activate/Select：这些方法很容易因为窗口切换、工作表焦点变化报错，应该直接引用对象，不用手动切换激活
• 缺少核心搜索逻辑：原代码没写“搜索今日日期”的关键代码，只做了打开工作簿的操作

修正后的完整代码 #

Sub SearchTodayDateInOtherWorkbook()
    ' 声明变量：wbCurrent是当前工作簿，wbTarget是要搜索的目标工作簿
    Dim wbCurrent As Workbook
    Dim wbTarget As Workbook
    Dim wsDatabase As Worksheet
    Dim searchRange As Range
    Dim foundCell As Range
    Dim todayDate As Date
    
    ' 初始化当前工作簿和Database工作表
    Set wbCurrent = ThisWorkbook
    Set wsDatabase = wbCurrent.Sheets("Database")
    
    ' 获取今日日期（只取日期部分，忽略时间）
    todayDate = Date
    
    ' 打开目标工作簿（U2单元格存路径/链接）
    On Error Resume Next ' 捕获路径错误
    Set wbTarget = Workbooks.Open(FileName:=wbCurrent.Sheets("Summary").Range("U2").Value)
    On Error GoTo 0
    
    ' 检查目标工作簿是否成功打开
    If wbTarget Is Nothing Then
        MsgBox "无法打开目标工作簿，请检查U2单元格的路径是否正确！", vbExclamation
        Exit Sub
    End If
    
    ' 假设你要在目标工作簿的第一个工作表搜索，可根据实际修改Sheet名称
    Set searchRange = wbTarget.Sheets(1).UsedRange
    
    ' 搜索今日日期
    Set foundCell = searchRange.Find(What:=todayDate, LookIn:=xlValues, LookAt:=xlWhole)
    
    ' 处理搜索结果
    If Not foundCell Is Nothing Then
        MsgBox "找到今日日期啦！位置：" & foundCell.Address(External:=True), vbInformation
        ' 可以在这里添加找到后的操作，比如复制数据到当前工作簿
        ' 示例：foundCell.EntireRow.Copy wsDatabase.Cells(wsDatabase.Rows.Count, 1).End(xlUp).Offset(1, 0)
    Else
        MsgBox "目标工作簿里没找到今日日期哦～", vbInformation
    End If
    
    ' 关闭目标工作簿（如果需要保存可以加SaveChanges:=True）
    wbTarget.Close SaveChanges:=False
End Sub

代码说明 #

• 去掉了所有Activate/Select，直接通过对象引用操作，更稳定
• 加入了错误捕获，防止U2路径错误导致崩溃
• 明确了搜索范围（目标工作簿的已用区域），你可以根据实际改成指定的工作表或单元格范围
• 搜索时匹配完整日期（LookAt:=xlWhole），避免部分匹配出错
• 最后可以选择是否关闭目标工作簿，按需调整SaveChanges参数

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