VBA .Find对象变量未设置错误

Question

好的，所以我正在尝试创建一个基本上类似于 vlookup 的宏，并在 A 列中逐个单元格搜索工作表 2 中 A 列中的相同值，然后将该行中的所有信息复制到第一个打开的列工作表 1。

基本上我不知道我在做什么，但它的功能大约有 95%。我唯一的问题是，一旦它遇到工作表 1 列 A 中的值，它在工作表 2 列 A 中找不到。我该怎么做才能跳到下一个值？

我的 If...then...else 是一次不顾一切地尝试跳过该值，显然它不起作用。

Sub ProLookUp()

Dim ColALastRow As Long
Dim ColALastRow2 As Long


ColALastRow = Worksheets(1).Columns("A:A").End(xlDown).Row
MsgBox ColALastRow

ColALastRow2 = Worksheets(2).Columns("A:A").End(xlDown).Row
MsgBox ColALastRow2

Dim i As Long
Dim Pro As String
Dim Pro2 As Long

For i = 1 To ColALastRow
Pro = Worksheets(1).Cells(i, 1).Value

'With Worksheets(2).Range("A1:A" & ColALastRow2)' 'ignore this part'

With Worksheets(2).Range("A1:A10000")

'the below is where my issue is, once it finds a value in column A that it
'cannot match in sheet 2 it returns the error
'Object variable or With block variable not set

If Pro = .Find(Pro, LookIn:=xlValues).Value Then
    Pro2 = .Find(Pro, LookIn:=xlValues).Row
Else
    i = i + 1
End If


    Dim LastColA As Integer
    Dim CopyRange As Range
    Dim a As Range
    Dim b As Range

        With Worksheets(2)
            LastColA = .Cells(Pro2, .Columns.Count).End(xlToLeft).Column
            Set a = .Cells(Pro2, 2)
            Set b = .Cells(Pro2, LastColA)
            Set CopyRange = Range(a, b)
        End With

    Dim PasteRange As Range
    Dim LastColumnB As Integer
        With Worksheets(1)
            LastColumnB = .Cells(i, .Columns.Count).End(xlToLeft).Column
            LastColumnB = LastColumnB + 1
            Set PasteRange = .Cells(i, LastColumnB)
            MsgBox PasteRange.Address

        End With

Worksheets(2).Select
    CopyRange.Select
    Selection.Copy
Worksheets(1).Select
    PasteRange.Activate
    ActiveCell.PasteSpecial

End With    
Next i
End Sub

Answer 1

我重新编写了一些其他代码。

带有 i=i+1 的 If 语句不会按照您的想法执行。

我将查找结果加载到一个范围变量中。如果查找未找到任何内容，则结果范围变量将为Nothing。由于您不能在 Nothing 上调用任何方法，因此会引发错误 91。为了解决它，在If 块中测试Nothing，并避免错误。

我们测试以确保范围变量Is Not Nothing，然后执行该操作。如果找到Nothing，则它会跳过代码并直接转到Next i。

尝试使用 if 将 1 添加到 i 不会触发 For 循环的下一次迭代。代码仍会尝试运行然后进行迭代，因此实际上会跳过行。

无需激活工作表和范围即可进行复制和粘贴。

Sub ProLookUp()

Dim ColALastRow As Long
Dim ColALastRow2 As Long


ColALastRow = Worksheets(1).Columns("A:A").End(xlDown).Row
MsgBox ColALastRow

ColALastRow2 = Worksheets(2).Columns("A:A").End(xlDown).Row
MsgBox ColALastRow2

Dim i As Long
Dim Pro As String
Dim fnd As Range
Dim Pro2 As Long

For i = 1 To ColALastRow
    Pro = Worksheets(1).Cells(i, 1).Value

    'With Worksheets(2).Range("A1:A" & ColALastRow2)' 'ignore this part'

    With Worksheets(2).Range("A1:A10000")

        'the below is where my issue is, once it finds a value in column A that it
        'cannot match in sheet 2 it returns the error
        'Object variable or With block variable not set
        Set fnd = .Find(Pro, LookIn:=xlValues)
    End With
    If Not fnd Is Nothing Then
        Pro2 = fnd.Row
        Dim LastColA As Integer
        Dim CopyRange As Range
        Dim a As Range
        Dim b As Range

        With Worksheets(2)
            LastColA = .Cells(Pro2, .Columns.Count).End(xlToLeft).Column
            Set a = .Cells(Pro2, 2)
            Set b = .Cells(Pro2, LastColA)
            Set CopyRange = Range(a, b)
        End With

        Dim PasteRange As Range
        Dim LastColumnB As Integer

        With Worksheets(1)
            LastColumnB = .Cells(i, .Columns.Count).End(xlToLeft).Column
            LastColumnB = LastColumnB + 1
            Set PasteRange = .Cells(i, LastColumnB)
            MsgBox PasteRange.Address
        End With


        CopyRange.Copy PasteRange

    End If


Next i
End Sub