求适配Excel VBA宏：按当前日期加6个月切换搜索sheet2列并高亮

核心调整逻辑 #

• 新增基准日期判断：自动计算当前日期加6个月的结果，提取月份匹配对应搜索列
  • 月份在1-6区间（≥1且<7）：锁定Sheet2的D列为搜索范围
  • 月份在7-12区间（≥7且<次年1月）：锁定Sheet2的J列为搜索范围
• 修复原代码报错隐患：增加匹配结果空值判断，找不到目标值时弹出提示，避免触发运行时错误
• 新增标色逻辑：搜索到匹配单元格后，自动为单元格设置指定填充色

完整适配代码 #

Sub findApp()
    ' 变量定义
    Dim lookfor As Variant
    Dim baseDate As Date
    Dim searchRange As Range
    Dim matchCell As Range
    
    ' 获取选中单元格的待搜索值
    lookfor = Selection.Value
    
    ' 计算日期判断基准：当前日期向后顺延6个月
    baseDate = DateAdd("m", 6, Date)
    
    ' 根据月份确定搜索范围
    If Month(baseDate) >= 1 And Month(baseDate) < 7 Then
        Set searchRange = ThisWorkbook.Sheets("Sheet2").Columns("D:D")
    Else
        Set searchRange = ThisWorkbook.Sheets("Sheet2").Columns("J:J")
    End If
    
    ' 在指定范围执行精确匹配搜索
    Set matchCell = searchRange.Find( _
        What:=lookfor, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
    
    ' 处理匹配结果
    If Not matchCell Is Nothing Then
        ' 激活目标工作表、选中匹配单元格、设置标色
        ThisWorkbook.Sheets("Sheet2").Activate
        matchCell.Select
        ' 默认设置浅黄填充，可自行修改RGB色值
        matchCell.Interior.Color = RGB(255, 255, 0)
    Else
        ' 无匹配结果时弹出提示
        MsgBox "未找到匹配内容：" & lookfor, vbInformation
    End If
End Sub

自定义调整说明 #

• 若实际工作表名称和代码中的Sheet2不一致，直接替换字符串为对应工作表名即可
• 标色的填充效果可通过修改Interior.Color后的RGB参数调整，比如需要设置浅绿填充可替换为RGB(200,255,200)
• 若数据存在固定有效区域，可将整列搜索范围替换为固定单元格区域，比如把Columns("D:D")改为Range("D2:D800")，提升搜索效率

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