Excel VBA查找单元格复制格式失效 报运行时错误'91'如何解决

我有一个简易电子表格，其中一个工作表存储日期列表与条目数据，另一个工作表为日历视图。最初创建文件时，我编写了对应VBA代码，用于在Sheet1中匹配日历日期，将Sheet1中设置的条件格式复制到日历对应单元格中。该功能此前运行正常，但我在Sheet1中新增更多条目后，突然触发Run-time error '91'，作为编程新手无法定位故障原因。

当前使用的原代码如下：

Sub find_and_paste_formatting()
    'On Error Resume Next (had to remove when it stopped working to find the error)'

    Dim Date_Row As Long
    Dim Date_Col As Long

    'Sheet with dates to use in find
    Table1 = Sheet2.Range("A5:G5").Cells
    
    'The cell from where you need to start populating the formatting
    Date_Row = Sheet2.Range("A6").Row
    Date_Col = Sheet2.Range("A6").Column

    For Each cl In Table1
        'Just a test to see if it returns the correct cell reference
        Sheet2.Cells(Date_Row, Date_Col) = Sheet1.Range("A1:D20").Find(cl, LookIn:=xlValues, Lookat:=xlWhole, After:=Range("A1"), SearchOrder:=xlRows).Address

        'change the formatting to match the sheet 1 conditional formatting
        Sheet2.Cells(Date_Row, Date_Col).Interior.ColorIndex = Sheet1.Range(Sheet1.Range("A1:D20").Find(cl, LookIn:=xlValues, Lookat:=xlWhole, After:=Range("A1"), SearchOrder:=xlRows).Address).DisplayFormat.Interior.ColorIndex
    
        Date_Col = Date_Col + 1    
    Next cl
End Sub

• 91错误的直接触发逻辑：Range.Find()方法在指定搜索范围内找不到匹配值时，会返回空对象Nothing，此时直接调用空对象的.Address属性就会抛出该错误。你在Sheet1新增条目后，大概率是Sheet2日历表头A5:G5中的某个日期不在硬编码的搜索范围Sheet1!A1:D20内，或是存在日期格式不匹配、单元格空值的情况，导致Find找不到目标。
• 隐性逻辑漏洞：代码中After:=Range("A1")没有明确指定所属工作表，默认会指向当前激活工作表的A1单元格，如果运行代码时活动工作表不是Sheet1，会直接导致搜索范围异常；同一次循环内重复调用两次Find方法，不仅效率低，还可能出现两次匹配结果不一致的问题。
• 扩展性缺陷：搜索范围硬编码为A1:D20，后续只要新增条目超出这个行列范围，就会出现匹配失败的问题；原代码未声明Table1、cl等变量，容易出现拼写错误导致的异常。

调整代码逻辑：首先声明专门的Range变量存储Find的匹配结果，每次搜索后先判断是否匹配到目标，再执行后续格式赋值操作；将搜索范围改为Sheet1的动态已用区域，避免硬编码范围的限制；明确所有Range对象的所属工作表，消除激活工作表带来的不确定性。

修复后可直接运行的代码如下：

' 建议在模块最顶部加这一句，强制所有变量提前声明，避免拼写错误
Option Explicit

Sub find_and_paste_formatting()
    Dim Date_Row As Long
    Dim Date_Col As Long
    Dim Table1 As Range
    Dim cl As Range
    Dim findResult As Range
    Dim searchRng As Range
    
    ' 定义搜索范围为Sheet1已用区域，自动适配新增的条目
    Set searchRng = Sheet1.UsedRange
    ' 定义日历表头的日期范围
    Set Table1 = Sheet2.Range("A5:G5").Cells
    
    ' 格式填充的起始位置
    Date_Row = Sheet2.Range("A6").Row
    Date_Col = Sheet2.Range("A6").Column

    For Each cl In Table1
        ' 执行查找，明确指定所有参数的所属对象，避免工作表激活导致的异常
        Set findResult = searchRng.Find( _
            What:=cl.Value, _
            LookIn:=xlValues, _
            Lookat:=xlWhole, _
            After:=searchRng.Cells(1, 1), _
            SearchOrder:=xlByRows)
        
        ' 先判断是否找到匹配值，找不到就清空对应单元格跳过，避免报错
        If Not findResult Is Nothing Then
            ' 写入匹配到的单元格地址做测试
            Sheet2.Cells(Date_Row, Date_Col) = findResult.Address
            ' 复制对应单元格条件格式的填充色
            Sheet2.Cells(Date_Row, Date_Col).Interior.ColorIndex = findResult.DisplayFormat.Interior.ColorIndex
        Else
            Sheet2.Cells(Date_Row, Date_Col).ClearContents
            Sheet2.Cells(Date_Row, Date_Col).Interior.ColorIndex = xlColorIndexNone
        End If
    
        Date_Col = Date_Col + 1
    Next cl
End Sub

补充说明：如果需要复制完整的条件格式规则而不是仅复制填充色，可以把赋值颜色的代码替换为格式粘贴逻辑：

findResult.Copy
Sheet2.Cells(Date_Row, Date_Col).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False ' 执行完清空剪贴板

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