如何用Excel VBA查找指定日期并选中其右侧单元格

我正尝试在Excel VBA中实现查找指定单元格并选中其右侧单元格的功能，但遇到了困难——无法在Data工作表中找到对应日期。以下是我的代码，其中两个关键功能以注释形式标注，附带Overview和Data工作表的截图：

Sub Save_Button()
    Range("D6:F6").Select
    Selection.Copy
    
    Dim varDate As Variant
    varDate = Range("C6").Value

    Sheets("Data").Select
        
    'Find the same date as the one saved in varDate in the sheet "Data"
    'Select the cell next to it

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Overview").Select
    Application.CutCopyMode = False
    Range("D6").Select
End Sub

解决方案 #

原代码核心问题是未正确使用Find方法，且依赖Select操作易导致不稳定。以下是修正后的代码，直接实现查找日期并粘贴到右侧单元格的功能：

Sub Save_Button()
    ' 直接引用复制区域，避免Select操作
    Dim copyRange As Range
    Set copyRange = ThisWorkbook.Sheets("Overview").Range("D6:F6")
    
    ' 明确变量为日期类型，避免格式匹配问题
    Dim targetDate As Date
    targetDate = ThisWorkbook.Sheets("Overview").Range("C6").Value
    
    Dim dataSheet As Worksheet
    Set dataSheet = ThisWorkbook.Sheets("Data")
    
    Dim foundCell As Range
    ' 在Data工作表的日期列（根据截图为A列）精确查找目标日期
    Set foundCell = dataSheet.Columns("A").Find( _
        What:=targetDate, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        MatchCase:=False)
    
    If Not foundCell Is Nothing Then
        ' 复制内容并粘贴到找到日期的右侧单元格
        copyRange.Copy
        foundCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    Else
        MsgBox "未找到对应日期，请检查！"
    End If
    
    Application.CutCopyMode = False
    ' 返回Overview工作表的指定单元格
    ThisWorkbook.Sheets("Overview").Range("D6").Select
End Sub

关键说明

• 取消Select/Selection：直接通过工作表和单元格对象引用，代码更高效稳定
• 日期类型匹配：将变量定义为Date类型，避免因数据类型不匹配导致查找失败
• Find参数优化：指定LookIn:=xlValues确保按单元格值查找，LookAt:=xlWhole实现精确匹配
• 异常处理：增加未找到日期的提示，避免程序报错
• Offset(0,1)：快速定位到找到单元格的右侧相邻单元格

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