Excel VBA查找无匹配值填充文本时类型不匹配错误解决

需求说明 #

• 在WBGrab工作簿的SheetName工作表B列查找值为Commercial Income的单元格
• 若找到匹配值：提取该单元格所在行C列到H列的内容，转置粘贴到WBPaste工作簿Sheet1工作表的对应位置，保留值和数字格式
• 若未找到匹配值：在WBPaste工作簿的C2:C7单元格区域填充占位符-
• 现存问题：运行原始代码时触发**类型不匹配（Type Mismatch）**错误

错误根因 #

1. 变量类型声明错误：原始代码将存储查找结果的变量c声明为Long（长整型值类型），但Find方法返回的是单元格对象（Range类型），后续用判断对象空值的Is Nothing语法判断值类型变量，直接触发类型不匹配错误
2. 空值逻辑前置错误：原始代码在Find执行后直接调用.Row属性取行号，一旦Find未找到匹配值返回Nothing，不存在Row属性会直接触发运行时错误
3. 语法结构缺失：原始代码If判断分支未写对应的End If，直接以End Sub收尾，语法不完整
4. 冗余的激活/选中操作：大量使用Activate、Select切换工作簿和单元格，容易因当前激活对象不符合预期触发额外错误

修正后完整代码 #

Sub FindAndPaste()
    Dim findRng As Range
    Dim sourceWB As Workbook, targetWB As Workbook
    Dim sourceSht As Worksheet, targetSht As Worksheet
    
    ' 绑定工作簿和工作表对象，避免依赖Activate选中
    Set sourceWB = Workbooks("WBGrab")
    Set sourceSht = sourceWB.Sheets("SheetName")
    Set targetWB = Workbooks("WBPaste")
    Set targetSht = targetWB.Sheets("Sheet1")
    
    ' 执行查找，返回Range对象
    Set findRng = sourceSht.Columns(2).Find( _
        What:="Commercial Income", _
        LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False _
    )
    
    ' 判断是否找到匹配值
    If findRng Is Nothing Then
        ' 未找到则填充占位符
        targetSht.Range("C2:C7").Value = "-"
    Else
        ' 找到则复制对应行C:H列内容，转置粘贴
        sourceSht.Range("C" & findRng.Row & ":H" & findRng.Row).Copy
        targetSht.Range("C2").End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValuesAndNumberFormats, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=True
        ' 清空剪贴板
        Application.CutCopyMode = False
    End If
End Sub

修正点说明 #

• 将存储查找结果的变量改为Range对象类型，匹配Find方法的返回值类型
• 先判断查找结果是否为空，再执行行号提取、复制操作，避免空对象调用属性报错
• 直接绑定工作簿、工作表对象，移除所有冗余的Activate、Select操作，提升代码稳定性
• 补全If分支的End If结构，修正语法错误
• 粘贴完成后清空剪贴板，避免残留复制状态影响后续操作

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