這裏是一個可能的解決方案
Option Explicit
Sub main()
Dim orderRng As Range, tag50Rng As Range, sheet3Rng As Range, testRng As Range
Dim cell As Range, found As Range
Dim testRowsOffset As Long
Set orderRng = GetRange("orders", "B", 2) '<--| set sheet "order" column "B" cells from row 2 down to last non empty one as range to seek values of in other ranges
Set tag50Rng = GetRange("tag50", "A") '<--| set sheet "tag50" column "A" cells from row 1 down to last non empty one as range where to do 1st lookup in
Set sheet3Rng = GetRange("sheet3", "A") '<--| set sheet "sheet3" column "A" cells from row 1 down to last non empty one as range where to do 2nd lookup in
Set testRng = Worksheets("test").Range("A4") '<--| set sheet "test" cell "A4" as range where to start returning values from downwards
For Each cell In orderRng '<--| loop through each cell of "order" sheet column "B"
Set found = tag50Rng.Find(what:=cell.Value, lookat:=xlWhole, LookIn:=xlValues) '<--| lookup for current cell value in "tag50" column "A"
If found Is Nothing Then '<--| if no match found
Set found = sheet3Rng.Find(what:=cell.Offset(, -1).Value, lookat:=xlWhole, LookIn:=xlValues) '<--| lookup for current cell offsetted 1 column left value in "sheet3" column "A"
If Not found Is Nothing Then '<--| if match found
testRng.Offset(testRowsOffset) = found.Offset(, 1).Value '<--| return sheet3 found cell offsetted 1 column right value
testRowsOffset = testRowsOffset + 1 '<--| update row offset counter from "test" cell A4
End If
End If
Next cell
End Sub
Function GetRange(shtName As String, col As String, Optional firstRow As Variant) As Range
' returns the range of the passed worksheet in the passed column from passed row to last non empty one
' if no row is passed, it starts from row 1
If IsMissing(firstRow) Then firstRow = 1
With Worksheets(shtName)
Set GetRange = .Range(.Cells(1, col), .Cells(.Rows.Count, col).End(xlUp))
End With
End Function
改變所有相關參數(表名稱,它們列在查找和行從開始),按您的需求
將代碼放在問題而不是代碼的圖片。 – newguy
你已經使用了兩個'Next xlCell'作爲一個'For'循環,這是不允許的。對於if語句,沒有'End if' – newguy