Excel VBA宏输入日期后始终提示值未找到问题求助

问题根源分析 #

1. 类型不匹配：InputBox返回的是文本字符串，而工作表中的日期是日期数据类型，两者直接对比无法匹配，导致VLookup查找失败。
2. 未明确指定工作表：代码里的Cells、Range没有绑定具体工作表，若操作时其他工作表处于激活状态，会引用错误区域。
3. 变量未声明类型：部分变量未做类型声明，可能引发隐式类型转换错误，干扰查找逻辑。

修改后的代码 #

Sub get_money()
    ' 声明变量，明确数据类型
    Dim ws As Worksheet
    Dim a_col_last_row As Long, d_col_last_row As Long
    Dim data_a As Variant, data_d As Variant
    Dim refRng_a As Range, refRng_d As Range
    
    ' 锁定目标工作表，避免引用错误
    Set ws = ThisWorkbook.Worksheets(1)
    
    ' 获取A列、D列的最后一行数据行号
    a_col_last_row = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    d_col_last_row = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row
    
    ' 输入日期并转换为日期类型，匹配工作表数据格式
    data_a = InputBox("输入第一个日期")
    If IsDate(data_a) Then data_a = CDate(data_a) Else GoTo errhandler1
    
    data_d = InputBox("输入第二个日期")
    If IsDate(data_d) Then data_d = CDate(data_d) Else GoTo errhandler2
    
    ' 绑定工作表设置查找范围
    Set refRng_a = ws.Range("A2:B" & a_col_last_row)
    Set refRng_d = ws.Range("D2:E" & d_col_last_row)
    
    ' 执行第一个日期的查找
    On Error Resume Next
    ws.Cells(3, 8).Value = WorksheetFunction.VLookup(data_a, refRng_a, 2, 0)
    If Err.Number <> 0 Then GoTo errhandler1
    On Error GoTo 0
    
    ' 执行第二个日期的查找
    On Error Resume Next
    ws.Cells(3, 9).Value = WorksheetFunction.VLookup(data_d, refRng_d, 2, 0)
    If Err.Number <> 0 Then GoTo errhandler2
    On Error GoTo 0
    
    Exit Sub
    
errhandler1:
    MsgBox "第一个日期对应值未找到，请输入正确的日期格式"
    Err.Clear
    Exit Sub
    
errhandler2:
    MsgBox "第二个日期对应值未找到，请输入正确的日期格式"
    Err.Clear
End Sub

关键修改说明 #

• 新增ws变量绑定目标工作表，确保所有单元格操作都指向正确的工作表。
• 将输入的日期文本转换为CDate日期类型，和工作表中的日期数据格式统一。
• 增加输入有效性判断，若输入内容不是日期直接触发错误提示。
• 优化错误处理逻辑，避免单个查找错误影响后续操作。
• 所有变量明确声明类型，提升代码稳定性和可读性。

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