匹配细胞内的任何单词与细胞范围内的任何单词

时间:2016-11-17 17:36:21

标签: excel vba excel-vba excel-formula udf

我有一个短语列表。我想检查是否有任何新术语与该列表逐字匹配。

我正在寻找一个代码来在列表上实现模糊匹配,以返回具有紧密匹配的单元格。

示例数据:

enter image description here

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

期望输出:

enter image description here

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))

但是,代码仅匹配整个单元格。如何使其与单元格中的任何单词匹配?这将创建模糊匹配。任何积极的投入都非常受欢迎。

1 个答案:

答案 0 :(得分:2)

这是针对您的问题的(粗略且准备好的)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