vba查找和查找下一個問題

我想在上搜索圖表BD與我的工作表Plan1上某個值alocacao匹配的所有條目。然後它應該將Column 2上的值複製到名爲tecnico1的單元格中（其他單元格被稱爲tecnico2, tecnico3 and tecnico4）。我說明下文：vba查找和查找下一個問題

與值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不太熟悉，所以我會很感激任何幫助，以瞭解它爲什麼不能正常工作。

編輯

我嘗試新的東西，我改變了它的一部分只是爲了測試它會粘貼單元格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

來源

2017-07-24 paulinhax

'FoundCell.Adress.Offset（0，-3）.Value'刪除'.Address' –

@ A.S.H謝謝。有趣的是，現在它複製的價值，但它是最後一場比賽，而不是第一次... – paulinhax

正常，因爲你在同一個地方複製所有的比賽;） –

好的假設你有片"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

來源

2017-07-24 19:42:17

我完全明白你在那裏做了什麼，但我也有一個運行時錯誤1004. – paulinhax

@paulinhax在哪一行？我懷疑沒有找到命名的範圍。我的意思是'tecnico1，tecnico2，tecnico3和tecnico4'的範圍（或者它們被鎖定了嗎？） –

我想你是對的，它在達到'Sheets（「Plan1」）時給了我錯誤。）.Value = FoundCell.Offset（-3）.Value'。它們沒有被鎖定，但它們是合併的單元格......我不知道它是否會影響某些內容，但是我檢查了命名範圍並且它存在。 – paulinhax

.Find和.FindNext算法使用方法如下...

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

來源

2017-07-24 19:45:50 sktneer

vba查找和查找下一個問題

回答

相關問題