我想在工作表Column 5BD上搜索所有与工作表alocacao上名为Plan1的值匹配的条目。然后,应将Column 2上的值复制到名为tecnico1的单元格(其他单元格称为tecnico2, tecnico3 and tecnico4)。我在下面说明:

excel - VBA的find和findnext问题-LMLPHP

值TESTE 2的单元格是alocacao

excel - VBA的find和findnext问题-LMLPHP

excel - VBA的find和findnext问题-LMLPHP

我尝试使用Find和FindNext,这是我到目前为止尝试过的:

Sub VerifProd_Click()

Dim FoundCell As Range
Dim LastCell As Range
Dim FirstAddr As String
Dim fnd As String
Dim i As Long

i = 2
fnd = Sheets(1).Range("alocacao").Value

With Sheets("BD").Columns(5)
    Set LastCell = .Cells(.Cells.Count)
End With

Set FoundCell = Sheets("BD").Columns(5).Find(what:=fnd, after:=LastCell)

If Not FoundCell Is Nothing Then
    FirstAddr = FoundCell.Address
End If

Do Until FoundCell Is Nothing
    Sheets("BD").Cells(i,2).Copy Sheets("Plan1").Range("tecnico" & i).Value
    i = i + 1
    Set FoundCell = Sheets("BD").Columns(5).FindNext(after:=FoundCell)
    If FoundCell.Address = FirstAddr Then
        Exit Do
    End If
Loop

End Sub


但是它不起作用,并且出现运行时错误1004,但是代码未突出显示。我对Find和FindNext不太熟悉,因此不胜感激,以帮助您理解为什么它无法正常工作。

编辑

我正在尝试一些新内容,并且更改了一部分内容只是为了测试它将值粘贴到单元格B26上。现在,我收到运行时错误438:

With Sheets("BD").Columns(5)
    Set LastCell = .Cells(.Cells.Count)
End With

Set FoundCell = Sheets("BD").Columns(5).Find(what:=fnd, after:=LastCell)

If Not FoundCell Is Nothing Then
    FirstAddr = FoundCell.Address
End If

Do Until FoundCell Is Nothing
    Sheets("Plan1").Range("B26") = FoundCell.Adress.Offset(0, -3).Value

    Set FoundCell = Sheets("BD").Columns(5).FindNext(after:=FoundCell)
    If FoundCell.Address = FirstAddr Then
        Exit Do
    End If
Loop

最佳答案

好的,假设您在工作表"Plan1"中有4个名称为tecnico1, tecnico2, tecnico3 and tecnico4的命名单元格,我建议进行以下修改,同时要记住我们应在4处停止匹配与命名范围tecnico数量相同的位置:

Sub VerifProd_Click()
    Dim FoundCell As Range, FirstAddr As String, fnd As String, i As Long

    fnd = Sheets(1).Range("alocacao").value
    Set FoundCell = Sheets("BD").Columns(5).Find(what:=fnd, _
        After:=Sheets("BD").Cells(Rows.count, 5), Lookat:=xlPart, _
        LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext)

    If FoundCell Is Nothing Then Exit Sub
    Do
        i = i + 1
        Sheets("Plan1").Range("tecnico" & i).value = FoundCell.Offset(,-3).Value2
        Set FoundCell = Sheets("BD").Columns(5).FindNext(After:=FoundCell)
    Loop Until FoundCell.Address = FirstAddr Or i >= 4
End Sub

10-07 17:19