VBA实现InputBox输入日期后选中date_wb对应条目问题咨询

问题修复方案 #

现有代码核心错误 #

• DateSerial参数顺序错误：VBA的DateSerial(年, 月, 日)参数顺序为年在前、月在中、日在后，你输入的日期格式是YYYY-MM-DD，拆分后inputstr(0)是年、inputstr(1)是月、inputstr(2)是日，原代码参数完全颠倒，导致日期校验失效。

完整可运行代码 #

以下代码包含「打开工作簿→校验输入日期→匹配选中对应日期条目」全流程，默认匹配日期存储在打开的工作簿第一个工作表的A列，可根据实际存储位置修改列号：

Sub 选中对应日期条目()
    Dim file_name As Variant
    Dim data_wb As Workbook
    Dim inputbx As String
    Dim inputstr As Variant
    Dim InputDate As Date
    Dim DateIsValid As Boolean
    Dim findRng As Range
    
    '选择目标工作簿
    file_name = Application.GetOpenFilename(Title:="选择目标工作簿")
    If file_name = False Then Exit Sub
    
    '打开目标工作簿
    Set data_wb = Application.Workbooks.Open(file_name)
    
    '输入并校验日期
    Do
        inputbx = InputBox("请输入日期，格式为：YYYY-MM-DD", , Format(VBA.Now, "YYYY-MM-DD"))
        If inputbx = vbNullString Then
            data_wb.Close SaveChanges:=False '未输入日期直接关闭打开的工作簿，可根据需求调整
            Exit Sub
        End If
        inputstr = Split(inputbx, "-")
        On Error Resume Next
        '修正DateSerial参数顺序
        InputDate = DateSerial(inputstr(0), inputstr(1), inputstr(2))
        On Error GoTo 0
        DateIsValid = IsDate(InputDate)
        If Not DateIsValid Then MsgBox "请输入格式正确的有效日期", vbExclamation
    Loop Until DateIsValid
    
    '在目标工作表A列匹配日期，可根据实际列修改Columns("A:A")为对应列
    Set findRng = data_wb.Sheets(1).Columns("A:A").Find(What:=InputDate, LookIn:=xlValues, LookAt:=xlWhole)
    If Not findRng Is Nothing Then
        '匹配到则激活工作簿并选中对应单元格所在的整行，不需要整行可改成findRng.Select
        data_wb.Activate
        findRng.EntireRow.Select
    Else
        MsgBox "未找到对应日期的条目", vbInformation
    End If
End Sub

额外注意事项 #

• 如果日期列存储的是文本格式而非日期格式，可将Find的参数改为What:=CStr(InputDate)即可正常匹配
• 如果要匹配多工作表的日期，可加循环遍历所有工作表查找即可

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