在excel中查找行值之间的文本相似性

时间:2017-03-07 19:56:03

标签: excel

假设我有9行记录。每3行具有相同的值。例如:

Mike
Mike
Mike
John
John
John
Ryan
Ryan
Ryan

有没有办法可以搜索这些记录的相似之处?例如拼写错误,其他字符,缺少字符等等。例如,正确的版本是Mike,但是列表中可能有值为Mke的记录不正确(拼写错误)错误)。我怎样才能找到并用正确的替换它?

上面的例子显然已经简化了。我实际上有~1mln行。现在要实现“分组”'我只是按字母顺序对它们进行排序。

3 个答案:

答案 0 :(得分:1)

我遇到了同样的问题!通过一些搜索,我可以获得并修改以下VBA代码,该代码将启用名为=Similarity()的函数。根据两个输入单元的相似性,该函数将输出一个从0到1的数字。

  • 我是如何使用它的:

我按字母顺序排列了我的列信息并应用了公式。然后我创建了一个Conditional Formatting Rule来突出显示具有高相似率的那些(即:至少65%)。然后我搜索每个突出显示的事件并手动修复我的记录。

  • <强>用法:

    =相似度(cell1,cell2)

Obs。:相似性指标从0到1(0%到100%)

  • 示例:

enter image description here

  • 要使用它,您必须:

    1. 打开VBE(Alt + F11)
    2. 插入模块
    3. 将以下代码粘贴到“模块窗口”

enter image description here

<强>代码:

Public Function Similarity(ByVal String1 As String, _
    ByVal String2 As String, _
    Optional ByRef RetMatch As String, _
    Optional min_match = 1) As Single

Dim b1() As Byte, b2() As Byte
Dim lngLen1 As Long, lngLen2 As Long
Dim lngResult As Long

If UCase(String1) = UCase(String2) Then
    Similarity = 1
Else:
    lngLen1 = Len(String1)
    lngLen2 = Len(String2)
    If (lngLen1 = 0) Or (lngLen2 = 0) Then
        Similarity = 0
    Else:
        b1() = StrConv(UCase(String1), vbFromUnicode)
        b2() = StrConv(UCase(String2), vbFromUnicode)
        lngResult = Similarity_sub(0, lngLen1 - 1, _
        0, lngLen2 - 1, _
        b1, b2, _
        String1, _
        RetMatch, _
        min_match)
        Erase b1
        Erase b2
        If lngLen1 >= lngLen2 Then
            Similarity = lngResult / lngLen1
        Else
            Similarity = lngResult / lngLen2
        End If
    End If
End If

End Function

Private Function Similarity_sub(ByVal start1 As Long, ByVal end1 As Long, _
                                ByVal start2 As Long, ByVal end2 As Long, _
                                ByRef b1() As Byte, ByRef b2() As Byte, _
                                ByVal FirstString As String, _
                                ByRef RetMatch As String, _
                                ByVal min_match As Long, _
                                Optional recur_level As Integer = 0) As Long
'* CALLED BY: Similarity *(RECURSIVE)

Dim lngCurr1 As Long, lngCurr2 As Long
Dim lngMatchAt1 As Long, lngMatchAt2 As Long
Dim I As Long
Dim lngLongestMatch As Long, lngLocalLongestMatch As Long
Dim strRetMatch1 As String, strRetMatch2 As String

If (start1 > end1) Or (start1 < 0) Or (end1 - start1 + 1 < min_match) _
Or (start2 > end2) Or (start2 < 0) Or (end2 - start2 + 1 < min_match) Then
    Exit Function '(exit if start/end is out of string, or length is too short)
End If

For lngCurr1 = start1 To end1
    For lngCurr2 = start2 To end2
        I = 0
        Do Until b1(lngCurr1 + I) <> b2(lngCurr2 + I)
            I = I + 1
            If I > lngLongestMatch Then
                lngMatchAt1 = lngCurr1
                lngMatchAt2 = lngCurr2
                lngLongestMatch = I
            End If
            If (lngCurr1 + I) > end1 Or (lngCurr2 + I) > end2 Then Exit Do
        Loop
    Next lngCurr2
Next lngCurr1

If lngLongestMatch < min_match Then Exit Function

lngLocalLongestMatch = lngLongestMatch
RetMatch = ""

lngLongestMatch = lngLongestMatch _
+ Similarity_sub(start1, lngMatchAt1 - 1, _
start2, lngMatchAt2 - 1, _
b1, b2, _
FirstString, _
strRetMatch1, _
min_match, _
recur_level + 1)
If strRetMatch1 <> "" Then
    RetMatch = RetMatch & strRetMatch1 & "*"
Else
    RetMatch = RetMatch & IIf(recur_level = 0 _
    And lngLocalLongestMatch > 0 _
    And (lngMatchAt1 > 1 Or lngMatchAt2 > 1) _
    , "*", "")
End If


RetMatch = RetMatch & Mid$(FirstString, lngMatchAt1 + 1, lngLocalLongestMatch)


lngLongestMatch = lngLongestMatch _
+ Similarity_sub(lngMatchAt1 + lngLocalLongestMatch, end1, _
lngMatchAt2 + lngLocalLongestMatch, end2, _
b1, b2, _
FirstString, _
strRetMatch2, _
min_match, _
recur_level + 1)

If strRetMatch2 <> "" Then
    RetMatch = RetMatch & "*" & strRetMatch2
Else
    RetMatch = RetMatch & IIf(recur_level = 0 _
    And lngLocalLongestMatch > 0 _
    And ((lngMatchAt1 + lngLocalLongestMatch < end1) _
    Or (lngMatchAt2 + lngLocalLongestMatch < end2)) _
    , "*", "")
End If

Similarity_sub = lngLongestMatch

End Function
  • 根据您的数据集输出

enter image description here

答案 1 :(得分:0)

我不知道一种完全自动化的方法。有一个Excel“模糊匹配”加载项可能会有所帮助:https://www.microsoft.com/en-us/download/details.aspx?id=15011

我用过它。它大部分时间都可以使用,但是可以使用更大的工作表。

答案 2 :(得分:0)

文字相似性会变得非常复杂,具体取决于您想要走多远。可以在本文A Survey of Text Similarity Approaches(Gomaa&amp; Fahmy,IJCA 2013)中找到对所有不同算法的完整调查。它会伤害你的头脑,但它是好东西。

特定于VBA,您可以参考此previous answer on SO