比较两列中的数据并将该值提取到另一列

我有一个包含许多城市的专栏(B)。 我想在列的每一行中search(A)。 如果它包含来自列B的值,则该值应写在列(C)中。

我做了一个search静态值的代码。 我希望这个值是(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是我想要创build的列。

尝试这个

  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 

也许有一个公式:

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

试试这个解决scheme

 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