试试如下的程序:
Sub FindTxt()
Dim i As Long, j As Long, NumberOfRows As Long, bFound As Boolean, VarText As String
NumberOfRows = 10 '10 is for testing, please specify your own
'if NumberOfRows are too large, the following program is not efficient
For i = 1 To NumberOfRows
VarText = Cells(i + 1, 1).Value
bFound = False
For j = 1 To NumberOfRows
If InStr(1, Cells(j + 1, 4).Value, VarText) > 0 Then 'i.e. if Var is in the Source
bFound = True
Exit For
End If
Next j
If bFound Then 'if found, print Target to column B
Cells(i + 1, 2).Value = Cells(i + 1, 5).Value
Else 'if not found, print VarText to column B
Cells(i + 1, 2).Value = VarText
End If
Next i
End Sub