如何为VBA的Find函数定义查找数组？附报错代码求助

一、修复「Application Defined or Object Defined error」错误 #

报错的核心原因是未明确指定Range对象的父工作表。代码中Range("A5").End(xlDown)没有绑定到Master Permitting-Test Sheet Copy Code工作簿的Sheet1，导致VBA默认使用当前活动工作表，若活动表不是目标表就会触发错误。

修复步骤： #

1. 引用已定义的New_Workbook对象，确保所有Range都明确归属到目标工作表。
2. 定义工作表变量，简化代码并避免重复书写长路径。

错误行修复后：

Dim wsNew As Worksheet
Set wsNew = New_Workbook.Worksheets("Sheet1")

With wsNew.Range("A5", wsNew.Range("A5").End(xlDown))
    ' 后续代码
End With

同样，计算Last_Old_Job的代码也存在相同问题，需同步修复：

Dim wsOld As Worksheet
Set wsOld = Old_Workbook.Worksheets("Sheet1")
Last_Old_Job = wsOld.Range("A5", wsOld.Range("A5").End(xlDown)).Rows.Count

二、为Find函数定义查找数组 #

若需要一次性查找多个值（即使用数组作为查找目标），可以先定义包含所有待查找值的数组，再循环遍历数组元素执行Find操作。

示例实现： #

1. 定义查找数组：

Dim findArray As Variant
findArray = Array("Job1", "Job2", "Job3") ' 替换为你的目标值

2. 遍历数组执行查找：

Dim searchVal As Variant
For Each searchVal In findArray
    Set New_Job_Range = wsNew.Range("A5", wsNew.Range("A5").End(xlDown)).Find( _
        What:=searchVal, LookIn:=xlValues, LookAt:=xlWhole)
    If Not New_Job_Range Is Nothing Then
        ' 找到匹配值后的操作，例如复制数据
        New_Job_Range.Offset(0, 3).Value = wsOld.Range("A5").Offset(n - 1, 3).Value
    End If
Next searchVal

三、完整修正后的代码 #

Sub Copy_Code()
    Dim FileLocation As String
    Dim Old_Workbook As Workbook
    Dim New_Workbook As Workbook
    Dim New_Job_Range As Range
    Dim Old_Job_Name As String
    Dim n As Integer
    Dim Last_Old_Job As Integer
    Dim wsOld As Worksheet
    Dim wsNew As Worksheet
    ' 可选：定义查找数组
    Dim findArray As Variant
    findArray = Array("Job1", "Job2", "Job3") ' 替换为实际需要查找的值

    ' 获取用户选择的文件路径
    FileLocation = Application.GetOpenFilename
    If FileLocation = "False" Then Exit Sub ' 用户取消选择时退出

    ' 打开旧工作簿并设置工作簿/工作表对象
    Set Old_Workbook = Application.Workbooks.Open(FileLocation)
    Set New_Workbook = Workbooks("Master Permitting-Test Sheet Copy Code")
    Set wsOld = Old_Workbook.Worksheets("Sheet1")
    Set wsNew = New_Workbook.Worksheets("Sheet1")

    ' 计算旧工作簿中最后一行数据（避免空行问题，推荐用xlUp）
    Last_Old_Job = wsOld.Cells(wsOld.Rows.Count, "A").End(xlUp).Row - 4 ' 从A5开始，所以减4

    ' 遍历旧工作簿中的每个任务
    For n = 1 To Last_Old_Job
        Old_Job_Name = wsOld.Range("A5").Offset(n - 1, 0).Value

        ' 方式1：单个值查找（原逻辑）
        With wsNew.Range("A5", wsNew.Cells(wsNew.Rows.Count, "A").End(xlUp))
            Set New_Job_Range = .Find(What:=Old_Job_Name, LookIn:=xlValues, LookAt:=xlWhole)
            If Not New_Job_Range Is Nothing Then
                ' 直接赋值替代复制粘贴，效率更高
                New_Job_Range.Offset(0, 3).Value = wsOld.Range("A5").Offset(n - 1, 3).Value
            End If
        End With

        ' 方式2：使用数组查找（如果需要查找多个值）
        ' Dim searchVal As Variant
        ' For Each searchVal In findArray
        '     Set New_Job_Range = wsNew.Range("A5", wsNew.Cells(wsNew.Rows.Count, "A").End(xlUp)).Find( _
        '         What:=searchVal, LookIn:=xlValues, LookAt:=xlWhole)
        '     If Not New_Job_Range Is Nothing Then
        '         New_Job_Range.Offset(0, 3).Value = wsOld.Range("A5").Offset(n - 1, 3).Value
        '     End If
        ' Next searchVal
    Next n

    ' 可选：关闭旧工作簿
    ' Old_Workbook.Close SaveChanges:=False
End Sub

额外优化点： #

• 使用xlUp计算最后一行，避免中间空行导致的范围错误。
• 直接赋值Value替代Copy/Paste，提升代码执行效率。
• 添加用户取消文件选择的判断逻辑。

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