在Excel中比较相似的文本字符串

14

我目前正在尝试从两个单独的数据源中协调“名称”字段。我有一些名称不完全匹配，但足够接近以至于可以被认为是匹配的（以下示例）。您对我如何可以改善自动比赛的数量有任何想法吗？我已经从匹配标准中删除了中间缩写。

在此处输入图片说明

当前比赛公式：

=IFERROR(IF(LEFT(SYSTEM A,IF(ISERROR(SEARCH(" ",SYSTEM A)),LEN(SYSTEM A),SEARCH(" ",SYSTEM A)-1))=LEFT(SYSTEM B,IF(ISERROR(SEARCH(" ",SYSTEM B)),LEN(SYSTEM B),SEARCH(" ",SYSTEM B)-1)),"",IF(LEFT(SYSTEM A,FIND(",",SYSTEM A))=LEFT(SYSTEM B,FIND(",",SYSTEM B)),"Last Name Match","RESEARCH")),"RESEARCH")
microsoft-excel  microsoft-excel-2010 
— 劳拉·凯恩·庞尼（Laura Kane-Punyon）
source

Answers:

12

您可能会考虑使用Microsoft模糊查找加载项。

从MS网站：

总览

Excel的模糊查找外接程序由Microsoft Research开发，并在Microsoft Excel中执行文本数据的模糊匹配。它可用于识别单个表中的模糊重复行，或用于模糊连接两个不同表之间的相似行。这种匹配对于包括拼写错误，缩写，同义词和添加/丢失的数据在内的各种错误具有鲁棒性。例如，它可能会检测到“ Mr. 安德鲁·希尔”，“山，安德鲁·R”。和“安迪·希尔”都指同一个基础实体，并在每次匹配时都返回相似度得分。虽然默认配置对各种文本数据（例如产品名称或客户地址）非常有效，但也可以针对特定域或语言自定义匹配。

— 科技龟
source
由于需要.net框架，因此需要管理员特权，因此我无法在办公室中安装插件。:-(
— jackjack
这很棒，但是我不能让它产生超过10行。我单击配置不成功。有小费吗？
— bjornte's
6

我会考虑使用此列表（仅英语部分）来帮助消除常见的起酥油。

另外，您可能要考虑使用一个函数，该函数将确切地告诉您两个字符串的“关闭”程度。以下代码来自这里，感谢smirkingman。

Option Explicit
Public Function Levenshtein(s1 As String, s2 As String)

Dim i As Integer
Dim j As Integer
Dim l1 As Integer
Dim l2 As Integer
Dim d() As Integer
Dim min1 As Integer
Dim min2 As Integer

l1 = Len(s1)
l2 = Len(s2)
ReDim d(l1, l2)
For i = 0 To l1
    d(i, 0) = i
Next
For j = 0 To l2
    d(0, j) = j
Next
For i = 1 To l1
    For j = 1 To l2
        If Mid(s1, i, 1) = Mid(s2, j, 1) Then
            d(i, j) = d(i - 1, j - 1)
        Else
            min1 = d(i - 1, j) + 1
            min2 = d(i, j - 1) + 1
            If min2 < min1 Then
                min1 = min2
            End If
            min2 = d(i - 1, j - 1) + 1
            If min2 < min1 Then
                min1 = min2
            End If
            d(i, j) = min1
        End If
    Next
Next
Levenshtein = d(l1, l2)
End Function

这将告诉您一个字符串要到达另一个字符串必须进行多少次插入和删除。我会尽量减少这个数字（姓氏应准确）。

— 苏安多斯
source
5

我有一个（长）公式可以使用。它不像上面的那些那么磨练-仅适用于姓氏，而不是全名-但您可能会发现它很有用。

所以，如果你有一个标题行，并想比较A2有B2，把这个在该行上（例如，任何其他细胞C2）和向下复制到结束。

= IF（A2 = B2，“ EXACT”，IF（SUBSTITUTE（A2，“-”，“”）= SUBSTITUTE（B2，“-”，“”），“连字符”，IF（LEN（A2）> LEN（ B2），IF（LEN（A2）> LEN（SUBSTITUTE（A2，B2，“”）），“ Whole String”，IF（MID（A2,1,1）= MID（B2,1,1），1， 0）+ IF（MID（A2,2,1）= MID（B2,2,1），1,0）+ IF（MID（A2,3,1）= MID（B2,3,1），1， 0）+ IF（MID（A2，LEN（A2），1）= MID（B2，LEN（B2），1），1,0）+ IF（MID（A2，LEN（A2）-1,1）= MID（B2，LEN（B2）-1,1），1,0）+ IF（MID（A2，LEN（A2）-2,1）= MID（B2，LEN（B2）-2,1），1 ，0）＆“°”），IF（LEN（B2）> LEN（SUBSTITUTE（B2，A2，“”）），“ Whole String”，IF（MID（A2,1,1）= MID（B2,1 ，1），1,0）+ IF（MID（A2,2,1）= MID（B2,2,1），1,0）+ IF（MID（A2,3,1）= MID（B2,3 ，1），1,0）+ IF（MID（A2，LEN（A2），1）= MID（B2，LEN（B2），1），1,0）+ IF（MID（A2，LEN（A2） -1,1）= MID（B2，LEN（B2）-1,1），1,0）+ IF（MID（A2，LEN（A2）-2,1）= MID（B2，LEN（B2）- 2,1），1,0）＆“°”）））））

这将返回：

  • 完全一样 -如果完全匹配
  • 连字符 -如果是一对双管名，但上面有一个连字符，另一个带有空格
  • 整个字符串 -如果一个姓氏全部是另一个姓氏的一部分（例如，如果史密斯已成为法国史密斯人）

之后，根据两者之间的比较点数，您将获得一个0°至6°的度数。（即6°比较好）。

正如我所说的那样，有些粗略和准备好了，但希望能使您进入正确的球场。

— 科里尔11
source
这在所有层面上都被低估了。做得非常好！您是否对此有任何更新？
— DeerSpotter
2

正在寻找类似的东西。我在下面找到了代码。我希望这对遇到这个问题的下一个用户有所帮助

对于Abracadabra / Abrakadabra，返回91％；对于好莱坞街/ Hollyhood Str，返回75％；对于佛罗伦萨/法国，返回62％；对于Disneyland，返回0

我想说它已经足够接近您想要的了:)

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
— 阿达什
source
您正在复制此答案中的代码而没有获得任何积分
— -phuclv
1

尽管我的解决方案不允许识别完全不同的字符串，但对于部分匹配（子字符串匹配）很有用，例如“这是一个字符串”，而“一个字符串”将导致“匹配”：

只需在要查找的表的字符串前后添加“ *”即可。

常用公式：

  • vlookup（A1，B1：B10,1,0）
  • cerca.vert（A1; B1：B10; 1; 0）

变成

  • vlookup（“ *”＆A1＆“ *”，B1：B10; 1,0）
  • cerca.vert（“ *”＆A1＆“ *”; B1：B10; 1; 0）

“＆”是concatenate（）的“简短版本”

— 跳高
source
1

此代码扫描列a和列b，如果在两列中都发现相似之处，则以黄色显示。您可以使用滤色器获取最终值。我还没有将该部分添加到代码中。

Sub item_difference()

Range("A1").Select

last_row_all = Range("A65536").End(xlUp).Row
last_row_new = Range("B65536").End(xlUp).Row

Range("A1:B" & last_row_new).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

For i = 1 To last_row_new
For j = 1 To last_row_all

If Range("A" & i).Value = Range("A" & j).Value Then

Range("A" & i & ":B" & i).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
  .PatternTintAndShade = 0
End With

End If
Next j
Next i
End Sub
— 阿什威斯·乌拉尔（Ashwith Ullal）
source
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.