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

时间:2016-07-28 20:03:28

标签: excel-vba vba excel

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

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

我的如果......那么......其他是绝望的尝试跳过这个价值,显然它不起作用。

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

1 个答案:

答案 0 :(得分:1)

我重写了其他一些代码。

使用i = i + 1的If语句将不会按照您的想法执行。

我将find的结果加载到范围变量中。如果查找没有找到任何结果,则结果范围变量将为Nothing。由于您无法在Nothing上调用任何方法,因此错误91会提升。要解决此问题,请在Nothing块中测试If,并避免错误。

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

通过尝试使用if来添加1,我将不会触发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