Excel VBA自动填充列公式跳过已有值单元格 二次运行报1004错误

• 需求：指定列向下填充跨表VLOOKUP公式时，自动跳过已有内容的单元格，从下一个空白单元格继续填充。例：B2:B10区域内B5已有值时，先填充B2:B4，跳过B5后继续填充B6:B10
• 故障现象：现有代码首次运行正常，第二次运行触发运行时错误'1004' - 未找到单元格，报错时代码仅向B2写入公式就触发调试中断
• 原有故障代码：

Sub FillDownFormulaOnlyBlankCells()
Dim wb As Workbook
Dim ws1, ws2 As Worksheet
Dim rDest As Range
Set wb = ThisWorkbook

Set ws1 = Sheets("Copy From")
Set ws2 = Sheets("Copy To")

ws2.Range("A1").Formula = "=IFERROR(IF(VLOOKUP(A2,'Copy From'!A:B,2,FALSE)=0,"""",VLOOKUP(A2,'Copy From'!A:B,2,FALSE)),"""")"

Set rDest = Intersect(ActiveSheet.UsedRange, Range("B2:B300").Cells.SpecialCells(xlCellTypeBlanks))

ws2.Range("B2").Copy rDest

End Sub

1. 未对SpecialCells(xlCellTypeBlanks)返回结果做判空：当指定范围内不存在空白单元格时，该方法返回Nothing，后续执行Copy操作会直接触发1004错误
2. 范围引用未显式绑定工作表：代码中ActiveSheet.UsedRange、Range("B2:B300")均依赖当前激活的工作表，与提前定义的Copy To工作表可能不匹配，易出现范围引用错位
3. 公式写入位置笔误：B列需要使用的VLOOKUP公式被误写入A1单元格

Sub FillDownFormulaOnlyBlankCells()
    Dim wb As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rDest As Range
    
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Copy From")
    Set ws2 = wb.Sheets("Copy To")
    
    ' 写入公式模板到B2单元格
    ws2.Range("B2").Formula = "=IFERROR(IF(VLOOKUP(A2,'Copy From'!A:B,2,FALSE)=0,"""",VLOOKUP(A2,'Copy From'!A:B,2,FALSE)),"""")"
    
    ' 错误捕获，处理无空白单元格的场景
    On Error Resume Next
    Set rDest = Intersect(ws2.UsedRange, ws2.Range("B2:B300").SpecialCells(xlCellTypeBlanks))
    On Error GoTo 0
    
    ' 仅当存在空白单元格时执行填充
    If Not rDest Is Nothing Then
        ws2.Range("B2").Copy rDest
    End If
End Sub

• 所有单元格、范围引用均显式绑定到目标工作表，不受当前激活工作表影响，不会出现引用错位
• 增加空白范围判空逻辑，当目标范围无空白单元格时直接跳过填充步骤，不会触发1004报错
• 修正公式写入位置，确保模板公式正确写入B2单元格
• 填充逻辑自动跳过所有已有内容的单元格，仅向空白单元格写入公式，完全匹配需求
• 可重复运行，不会因后续运行时空白单元格减少出现报错

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