2列の部分一致と別の列の結果

Question

私は2列（A & B）を持っていますが、これらの2つの列の部分一致を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：これはただのサンプルリストです。通常、リストには、より多くのエントリがありますが、常にB列には、5つの値

が

Answer 1

EDIT2ありがとうござい必要があります：G54またはエントリの1：このバージョンは、自動的に一度G50で5つのエントリがあります更新しますをその範囲で変更されます。データがあるシートのワークシートコードにこれを入れます。このコードは簡単に更新され、必要な範囲を確認できます（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 

Answer 2

シンプルコード、

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