2列之间的部分匹配，并导致另一列

我有2列（A和B），我想在列C中获得这两列的部分匹配。 例如 ：

A Lore: Excavator Lore: Scribe Athletics: Strong Back Healing: Medicine Melee: No Mercy Insight: Sixth Sense Melee: Strong Man Parry: Stage Fighting Healing: Cure Wounds Craft: Journeyman Craft: Master Crafter Discipline: Courageous Discipline: Jaded Linguistics: Accent Stealth: Living Shadows B ---- Lore Healing Parry Stealth Craft C (Should be) ---- Lore: Excavator Lore: Scribe Healing: Medicine Healing: Cure Wounds Parry: Stage Fighting Stealth: Living Shadows Craft: Journeyman Craft: Master Crafter 

ps：这只是一个示例列表。 通常A列表将有更多的条目，但总是B列将有5个值

谢谢

Answer 1

更简单的代码供您尝试，

 Sub findMatch() Dim i As Long, j As Long, k As Long k = 1 For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row For j = 1 To 5 If InStr(Cells(i, 1), Cells(j, 2)) Then Cells(k, 3) = Cells(i, 1) k = k + 1 End If Next j Next i End Sub 

Answer 2

编辑2：一旦G50：G54中有五个条目，或者该范围中的一个条目发生更改，此版本将自动更新。 把它放在工作表的代码中，数据是在表单上。 此代码很容易更新，以检查您想要的任何范围（只需更改rng1，rng2或rng3）。

 Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim rng1 As Range, rng2 As Range, rng3 As Range Set ws = ActiveSheet Set rng1 = ws.Range("D50:D80") Set rng2 = ws.Range("G50:G54") Set rng3 = ws.Range("H50:H80") If Not Intersect(rng2, Target) Is Nothing Then If Application.CountA(rng2) >= 5 Then rng3.ClearContents For x = rng1.Cells(1, 1).Row To rng1.Cells(1, 1).Row + Application.CountA(rng1) - 1 For y = rng2.Cells(1, 1).Row To rng2.Cells(1, 1).Row + Application.CountA(rng2) - 1 If InStr(rng1.Cells(x - rng1.Cells(1, 1).Row + 1, 1).Text, rng2.Cells(y - rng2.Cells(1, 1).Row + 1, 1).Text) Then ws.Cells(Application.CountA(rng3) + rng3.Cells(1, 1).Row, rng3.Cells(1, 1).Column).Formula = rng1.Cells(x - rng1.Cells(1, 1).Row + 1, 1).Text End If Next y Next x End If End If End Sub