匹配單元格內的任何單詞與單元格範圍內的任何單詞

Question

我有一個短語列表。我想檢查是否有任何新詞彙與詞彙部分匹配。

我正在尋找一個代碼來實現列表上的模糊匹配以返回具有緊密匹配的單元格。

實施例的數據：

Phrases,Terms 
real term,new words 
great work,new term 
check phrase,more phrase 
example here,great alpha 
phrase random,beta new 

所需的輸出：

Phrases,Term,Match 
real term,new words,No match 
great work,new term,real term 
check phrase,more phrase,check phrase/phrase random 
example here,great alpha,great work 
phrase random,beta new,No match 

我有什麼：

我嘗試使用下面的代碼到細胞匹配，一旦發現：

=IF(ISERROR(MATCH("*" & B2 & "*",A:A, 0)), "No Match", VLOOKUP("*" & B2 & "*",A:A,1,FALSE)) 

但是，代碼只有整個單元格相匹配。我怎樣才能讓它匹配單元格中的任何單詞？這將創建一個模糊匹配。任何積極的投入是高度讚賞。

Answer 1

這裏是一個（粗糙和準備好）的VBA解決方案，以您的問題。您將需要將其插入VBA編輯器中的代碼模塊，然後您可以運行宏以獲得所需的輸出

Sub FindSimilar() 
    Dim phrases As Range, phrase As Range 
    Dim terms As Range, term As Range 
    Dim matches As String 
    Dim words() As String 

    'ensure this has the correct sheet names for your workbook 
    Set phrases = ThisWorkbook.Worksheets("Sheet2").Range("A2:A6") 
    Set terms = ThisWorkbook.Worksheets("Sheet1").Range("D2:D6") 

    For Each term In terms 
     matches = vbNullString 
     words() = Split(term.Value) 

     For i = 0 To UBound(words, 1) 
      For Each phrase In phrases 
       If InStr(1, phrase.Value, words(i)) Then 
        matches = matches & phrase & "/" 
       End If 
      Next phrase 
     Next i 

     If matches <> vbNullString Then 
      term.Offset(0, 5).Value = Left(matches, Len(matches) - 1) 
     Else 
      term.Offset(0, 5).Value = "No match" 
     End If 
    Next term 
End Sub