模糊字符串匹配优化（不检查某些单词）-Excel VBA函数

我在Excel中有一个函数，用于计算两个字符串之间的Levenshtein距离（将一个字符串转换为另一个字符串所需的插入、删除和/或替换次数）。我使用它作为我正在进行的一个项目的一部分，该项目涉及“模糊字符串匹配”

下面您将看到LevenshteinDistance函数和valuePhrase函数的代码。后者用于执行电子表格中的函数。这是我从报纸上读到的

'计算两个字符串之间的Levenshtein距离（插入的数量，
'将第一个字符串转换为第二个字符串所需的删除和替换）`
公共函数levenshteindication（ByRef S1作为字符串，ByVal S2作为字符串）的长度
Dim L1为长，L2为长，D（）为长输入字符串和距离矩阵的长度
Dim i为Long，j为Long，cost为Long'循环计数器和
“替换当前字母”
Dim cI为Long，cD为Long，cS为Long“下一次插入、删除和删除的成本
替代
L1=Len（S1）：L2=Len（S2）
重拨D（0到L1，0到L2）
对于i=0到L1:D（i，0）=i:Next i
对于j=0到L2:D（0，j）=j:Next j
对于j=1到L2
对于i=1到L1
成本=资产负债表（StrComp（中间美元（S1，i，1），中间美元（S2，j，1），vbTextCompare））
cI=D（i-1，j）+1
cD=D（i，j-1）+1
cS=D（i-1，j-1）+成本
如果cI您的整个问题可以替换为“如何在VBA中使用替换函数？”。一般来说，问题中的算法看起来很有趣，因此我为您做了这件事。只需在函数的
Array（）
中添加任何内容即可（只需在数组中以小写形式写入值）：

就你而言：

    S1 = removeSpecificWords(S1)
    S2 = removeSpecificWords(S2)
    valuePhrase = LevenshteinDistance(S1, S2)

当我在尝试删除重复地址时遇到类似问题时，我以另一种方式解决了这个问题，并使用了最长的公共子字符串

Function DetermineLCS(source As String, target As String) As Double
    Dim results() As Long
    Dim sourceLen As Long
    Dim targetLen As Long
    Dim counter1 As Long
    Dim counter2 As Long

    sourceLen = Len(source)
    targetLen = Len(target)

    ReDim results(0 To sourceLen, 0 To targetLen)

    For counter1 = 1 To sourceLen
        For counter2 = 1 To targetLen
            If Mid$(source, counter1, 1) = Mid$(target, counter2, 1) Then
                results(counter1, counter2) = results(counter1 - 1, counter2 - 1) + 1
            Else
                results(counter1, counter2) = WorksheetFunction.Max(results(counter1, _
                        counter2 - 1), results(counter1 - 1, counter2))
            End If
        Next counter2
    Next counter1

    'return the percentage of the LCS to the length of the source string
    DetermineLCS = results(sourceLen, targetLen) / sourceLen
End Function

对于地址，我发现大约80%的匹配使我接近100%的匹配。对于保险公司的名称（我以前在这个行业工作，所以我知道你面临的问题），我可能会建议90%的目标，甚至是Levenshtein距离和LCS的组合，将前者最小化，将后者最大化。
替换“保险”和“公司”在调用
levenshteindication
@FlorentB之前，在
s1
和
s2
中使用空字符串。我不确定我是否完全理解你的答案。我在哪里用空字符串替换“保险”和“公司”呢？在我名单上保险公司的名字里？我仍然希望能够看到该公司的全名（例如，如果它显示“All America Insurance company”，我不希望我的列标题更改为“All America”）。我希望函数忽略这些单词，而不必从表本身的字符串中删除这些单词。请注意，可以通过使用字节数组而不是字符串进一步优化Levenshtein距离函数。请阅读：问题：您正在比较多少个字符串，以及当前需要多长时间？Levenshtein在计算上很昂贵，你只想把它作为最后的手段。我在我的模糊匹配算法中使用了级联分类逻辑，当它基于直接匹配、别名匹配、部分子串匹配以及最后的Levenshtein找到合适的候选时，就会出现这种逻辑。这意味着我只需要在我绝对需要的时候拔出莱文施坦的“大炮”。这非常有帮助，谢谢！后续问题：我注意到，一旦我实现了您在这里编写的代码，我就开始获得更准确的数据。但是，也有“Company”缩写为“Co”、“Co.”等的情况。我尝试将这些特定字符串添加到数组中，但这并没有改变包含这些特定单词的字符串的Levenshtein距离。你能告诉我原因吗？@larryltj-这取决于你在哪个位置加了“Co”和“Co”。如果您将它们添加到这里
数组（“保险”、“公司”、“公司”、“公司”、“公司”、“控股”、“公司”）
则不应更改。此外，请仅以小写形式添加它们。像这样的
co
和
co.
。实际上忽略这个案例，我已经重写了它，所以它可以工作。
    S1 = removeSpecificWords(S1)
    S2 = removeSpecificWords(S2)
    valuePhrase = LevenshteinDistance(S1, S2)

Function DetermineLCS(source As String, target As String) As Double
    Dim results() As Long
    Dim sourceLen As Long
    Dim targetLen As Long
    Dim counter1 As Long
    Dim counter2 As Long

    sourceLen = Len(source)
    targetLen = Len(target)

    ReDim results(0 To sourceLen, 0 To targetLen)

    For counter1 = 1 To sourceLen
        For counter2 = 1 To targetLen
            If Mid$(source, counter1, 1) = Mid$(target, counter2, 1) Then
                results(counter1, counter2) = results(counter1 - 1, counter2 - 1) + 1
            Else
                results(counter1, counter2) = WorksheetFunction.Max(results(counter1, _
                        counter2 - 1), results(counter1 - 1, counter2))
            End If
        Next counter2
    Next counter1

    'return the percentage of the LCS to the length of the source string
    DetermineLCS = results(sourceLen, targetLen) / sourceLen
End Function