比較兩列中的數據並將值提取到另一列

Question

我有一列（B），其中包含許多城市。 我想搜索列（A）的每一行。 如果它包含來自B列的值，則該值應寫入（C）列。

我編寫了一個搜索靜態值的代碼。 我希望該值成為（A列）的行。

Public Function searchColumn()

V_End_Of_Table = ActiveSheet.UsedRange.Rows.Count 'count the number of rows used'


Dim cell As Range


For Each cell In Range("A1:A" & V_End_Of_Table)
    If InStr(1, cell.Value, "anfa", vbTextCompare) > 0 Then
        Range("C" & cell.Row).Value = "anfa"
    Else
        Range("C" & cell.Row).Value = "No Match Found"
    End If
Next 'move onto next cell'

End Function

編輯

Column A    |   Column B    |   Column C
------------+---------------+------------ 
casa anfa   |   omar        |   anfa
rabat hassan|   hassan      |   hassan
casa maarouf|   maarouf     |   maarouf
casa omar   |   anfa        |   omar
            |   sultan      |
            |   driss       |

C列是我要創建的列。

Answer 1

嘗試這個

 For i = 1 To V_End_Of_Table 'loop for column A
       For j = 1 To V_End_Of_Table 'loop for column B
          If InStr(1, Cells(i, 1).Value, Cells(j, 2).Value) > 0 Then
             Cells(i, 3).Value = Cells(j, 2).Value 'write found B value in c column
             Exit For
          Else
             Cells(i, 3).Value = "no match found"
          End If
          If Cells(j + 1, 2).Value = "" Then
            Exit For
          End If
       Next j
    Next i

Answer 2

試試這個解決方案

Sub test()
Dim oCellSearch As Range, oCellSource As Range, KeySource, Key
Dim Source As Object: Set Source = CreateObject("Scripting.Dictionary")
Dim Search As Object: Set Search = CreateObject("Scripting.Dictionary")
'Grab the data from the WorkSheets into Dictionaries
n = Cells(Rows.Count, "B").End(xlUp).Row
For Each oCellSearch In ActiveSheet.Range("B1:B" & n)
    If oCellSearch.Value <> "" Then
        Search.Add oCellSearch.Row, oCellSearch.Value
    End If
Next
n = Cells(Rows.Count, "A").End(xlUp).Row
For Each oCellSource In ActiveSheet.Range("A1:A" & n)
    If oCellSource.Value <> "" Then
        Source.Add oCellSource.Row, oCellSource.Value
    End If
Next
'Match for contain
For Each Key In Search
    For Each KeySource In Source
        If UCase(Source(KeySource)) Like "*" & UCase(Search(Key)) & "*" Then
            ActiveSheet.Cells(Key, "C").Value = Search(Key): Exit For
        End If
    Next
Next
End Sub

Answer 3

也許有一個公式：

=IF(ISERROR(MATCH("*"&B1,A:A,0)),"",MID(A1,FIND(" ",A1)+1,LEN(A1)))