VBA宏开发求助：实现类VLOOKUP/HLOOKUP的跨工作簿数据复制

你好！这个错误的核心原因是当Find方法找不到匹配的参考值时，会返回Nothing，这时候你尝试访问它的Address属性就会触发"对象变量或With块变量未设置"的错误。另外你的代码还有一些可以优化的地方，比如避免重复操作、处理空值和边界情况，下面是修复后的代码和详细说明：

问题根源分析 #

在你的循环里，当vRng2.Find(what:=vRef1)找不到对应值时，vDest1会变成Nothing，接下来执行Set vDest2 = Range(vDest1.Address)就会直接报错，因为Nothing没有Address属性。同时，你的循环终止条件vRef1 <> ""也不够严谨，应该检查单元格是否真的为空（比如单元格可能是公式返回的空字符串）。

修复后的代码 #

Sub copyv5input()
    Dim wsSrc As Worksheet, wbSrc As Workbook
    Dim wsTgt As Worksheet, wbTgt As Workbook
    Dim vRng1 As Range, vRng2 As Range
    Dim vRef1 As Range, vNo As Range
    Dim vDest1 As Range, vDest3 As Range
    Dim rNum As Integer, cNum As Integer
    
    rNum = 1
    cNum = 1
    
    ' 选择源参考范围
    Set vRng1 = Application.InputBox("Select the range of reference data:", Type:=8)
    ' 选择目标参考范围
    Set vRng2 = Application.InputBox("Select the reference data range for destination:", Type:=8)
    
    ' 循环遍历源参考范围的每一行
    Do While rNum <= vRng1.Rows.Count
        Set vRef1 = vRng1.Cells(rNum, cNum)
        
        ' 先检查源单元格是否为空，避免无效查找
        If Trim(vRef1.Value) <> "" Then
            ' 查找目标匹配项，指定查找参数更稳定
            Set vDest1 = vRng2.Find(What:=vRef1.Value, _
                                   LookIn:=xlValues, _
                                   LookAt:=xlWhole, _
                                   MatchCase:=False)
            
            ' 只有找到匹配项时才执行复制操作
            If Not vDest1 Is Nothing Then
                Set vNo = vRef1.Offset(0, 4).Resize(, 4)
                Set vDest3 = vDest1.Offset(0, 1).Resize(, 4)
                vNo.Copy Destination:=vDest3
            Else
                ' 可选：如果没找到可以输出提示
                Debug.Print "未找到匹配值: " & vRef1.Value & " (行号: " & rNum & ")"
            End If
        End If
        
        rNum = rNum + 1
    Loop
    
    MsgBox "数据复制完成！", vbInformation
End Sub

关键修改点 #

• 增加Find方法的参数：指定LookIn:=xlValues和LookAt:=xlWhole，让查找更准确（避免匹配单元格格式或部分内容），MatchCase:=False忽略大小写。
• 检查Find结果是否为Nothing：在使用vDest1之前先判断If Not vDest1 Is Nothing Then，避免访问不存在的对象属性。
• 优化循环终止条件：用rNum <= vRng1.Rows.Count代替vRef1 <> ""，确保遍历完所有选中的行，不会因为中间有空行提前终止。
• 增加源单元格空值检查：避免对空单元格执行无效的查找操作。
• 移除多余变量：删除了vDest2等不必要的变量，简化代码结构。
• 添加调试提示：如果没找到匹配值，会在VBA编辑器的立即窗口输出提示，方便排查问题。

额外建议 #

1. 处理大数量数据时，建议关闭屏幕更新和事件触发，提升运行速度：

Application.ScreenUpdating = False
Application.EnableEvents = False

' 你的代码...

Application.ScreenUpdating = True
Application.EnableEvents = True

2. 如果参考值是唯一的，可以考虑用Match方法代替Find，速度会更快：

Dim matchRow As Variant
matchRow = Application.Match(vRef1.Value, vRng2, 0)
If Not IsError(matchRow) Then
    Set vDest1 = vRng2.Cells(matchRow, 1)
    ' 后续复制操作...
End If

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