与查找和findnext的问题

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

在这里输入图像说明

TESTE 2的单元格是alocacao

在这里输入图像说明

在这里输入图像说明

我试图使用查找和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,所以我将不胜感激任何帮助,以了解为什么它不能正常工作。

编辑

我正在尝试新的东西,我改变了它的一部分,只是为了testing它将粘贴在单元格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 

好吧,假设你在名为tecnico1, tecnico2, tecnico3 and tecnico4表格"Plan1"有4个命名单元格,我build议进行以下修改,记住我们应该停止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 

.Find和.FindNextalgorithm如下所示…

 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