vba problems with find and findnext

2019-07-14 18:49发布

I want to search on Column 5 on sheet BD all the entries that matches with some value called alocacao on my sheet Plan1. Then it should copy the value on Column 2 to the cell called tecnico1 (the other cells are called tecnico2, tecnico3 and tecnico4). I illustrate below:

enter image description here

The cell with the value TESTE 2 is the alocacao.

enter image description here

enter image description here

I tried to use Find and FindNext and this is what I tried so far:

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

But it doesn't work and I get Run-time error 1004 but the code is not highlighted. I'm not too familiar with Find and FindNext so I'll appreciate any help to understand why it's not working propperly.

EDIT

I was trying something new and I changed a part of it just to test it will paste the value on cell B26. Now I'm getting Run-time error 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

2条回答
欢心
2楼-- · 2019-07-14 18:56

Ok supposing you have 4 named cells in sheet "Plan1" with names tecnico1, tecnico2, tecnico3 and tecnico4, I suggest the following modification, having in mind that we should stop at 4 matches which the number of named ranges 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
查看更多
再贱就再见
3楼-- · 2019-07-14 19:16

.Find and .FindNext algorithm is used like below...

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

    If Not FoundCell Is Nothing Then
        FirstAddr = FoundCell.Address
        Do
            Sheets("BD").Cells(i, 2).Copy Sheets("Plan1").Range("tecnico" & i).Value
            i = i + 1
            Set FoundCell = .FindNext(FoundCell)
        Loop While Not FoundCell Is Nothing And FirstAddr <> FoundCell.Address
    End If
End With
查看更多
登录 后发表回答