Sub DelWord()
Dim aPfras(), aWord()
Dim lRwF As Long, lRw As Long
Dim i As Long, k As Long
    With ActiveSheet
        lRwF = .Cells(.Rows.Count, 1).End(xlUp).Row
        aPfras = .Range("A1:A" & lRwF).Value
        lRw = .Cells(.Rows.Count, 2).End(xlUp).Row
         aWord = .Range("B1:B" & lRwF).Value
    End With
    
    For k = 2 To lRw
         aWord(k, 1) = " " & aWord(k, 1) & " "
    Next k

    For i = 2 To lRwF
         aPfras(i, 1) = " " & aPfras(i, 1) & " "
    
        For k = 2 To lRw
            aPfras(i, 1) = Replace(aPfras(i, 1), aWord(k, 1), "")
        Next k
        
        aPfras(i, 1) = Trim$(aPfras(i, 1))
    Next i
        
    ActiveSheet.Range("A1:A" & lRwF).Value = aPfras
End Sub