Vergleichen ähnlicher Textzeichenfolgen in Excel

Ich versuche derzeit, "Name" -Felder aus zwei separaten Datenquellen abzugleichen. Ich habe eine Reihe von Namen, die nicht exakt übereinstimmen, aber nahe genug sind, um als übereinstimmend angesehen zu werden (Beispiele unten). Haben Sie Ideen, wie ich die Anzahl der automatisierten Übereinstimmungen verbessern kann? Ich entferne bereits mittlere Initialen aus den Übereinstimmungskriterien.

Aktuelle Spielformel:

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

Sie können das Microsoft Fuzzy Lookup Addin verwenden .

Von der MS-Site:

Überblick

Das Fuzzy Lookup Add-In für Excel wurde von Microsoft Research entwickelt und führt einen Fuzzy-Abgleich von Textdaten in Microsoft Excel durch. Es kann verwendet werden, um doppelte Fuzzy-Zeilen innerhalb einer einzelnen Tabelle zu identifizieren oder ähnliche Zeilen durch Fuzzy-Verknüpfung zwischen zwei verschiedenen Tabellen zu verbinden. Der Abgleich ist robust gegenüber einer Vielzahl von Fehlern, einschließlich Rechtschreibfehlern, Abkürzungen, Synonymen und hinzugefügten / fehlenden Daten. Beispielsweise könnte es feststellen, dass die Zeilen „Mr. Andrew Hill “,„ Hill, Andrew R. “ und „Andy Hill“ beziehen sich alle auf dieselbe zugrunde liegende Entität und geben zusammen mit jedem Match eine Ähnlichkeitsbewertung zurück. Während die Standardkonfiguration für eine Vielzahl von Textdaten wie Produktnamen oder Kundenadressen gut funktioniert, kann der Abgleich auch für bestimmte Domänen oder Sprachen angepasst werden.

Ich würde versuchen, diese Liste (nur englischer Abschnitt) zu verwenden, um die üblichen Verkürzungen auszusortieren.

Außerdem möchten Sie möglicherweise eine Funktion verwenden, die Ihnen genau sagt, wie "nahe" zwei Zeichenfolgen sind. Der folgende Code kam von hier und dank Grinsen .

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

Dadurch erfahren Sie, wie viele Einfügungen und Löschungen an einer Zeichenfolge vorgenommen werden müssen, um an die andere zu gelangen. Ich würde versuchen, diese Zahl niedrig zu halten (und Nachnamen sollten genau sein).

Ich habe eine (lange) Formel, die Sie verwenden können. Es ist nicht so gut geschliffen wie die oben genannten - und funktioniert nur für den Nachnamen und nicht für einen vollständigen Namen -, aber Sie finden es möglicherweise nützlich.

Wenn Sie also eine Kopfzeile haben und A2mit B2dieser vergleichen möchten , platzieren Sie diese in einer anderen Zelle in dieser Zeile (z. B. C2) und kopieren Sie sie bis zum Ende.

= WENN (A2 = B2, "GENAU", WENN (ERSATZ (A2, "-", "") = ERSATZ (B2, "-", ""), "Bindestrich", WENN (LEN (A2)> LEN ( B2), IF (LEN (A2)> LEN (SUBSTITUT (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 (SUBSTITUT (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) & "°"))))

Dies wird zurückkehren:

• GENAU - wenn es eine genaue Übereinstimmung ist
• Bindestrich - wenn es sich um ein Paar doppelter Namen handelt, aber ein Bindestrich und der andere ein Leerzeichen haben
• Ganze Zeichenfolge - wenn der gesamte Familienname Teil des anderen ist (z. B. wenn aus einem Smith ein French-Smith geworden ist)

Danach erhalten Sie einen Grad von 0 ° bis 6 °, abhängig von der Anzahl der Vergleichspunkte zwischen den beiden. (dh 6 ° vergleicht besser).

Wie ich schon sagte ein bisschen rau und bereit, bringt dich aber hoffentlich in ungefähr den richtigen Ballpark.

War auf der Suche nach etwas Ähnlichem. Ich habe den Code unten gefunden. Ich hoffe, dies hilft dem nächsten Benutzer, der zu dieser Frage kommt

Rendite 91% für Abracadabra / Abrakadabra, 75% für Hollywood Street / Hollyhood Str, 62% für Florenz / Frankreich und 0% für Disneyland

Ich würde sagen, es ist nah genug an dem, was du wolltest :)

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

Sie können die Ähnlichkeitsfunktion (pwrSIMILARITY) verwenden, um die Zeichenfolgen zu vergleichen und eine prozentuale Übereinstimmung der beiden zu erhalten. Sie können zwischen Groß- und Kleinschreibung unterscheiden oder nicht. Sie müssen entscheiden, wie viel Prozent einer Übereinstimmung für Ihre Anforderungen "nah genug" sind.

Es gibt eine Referenzseite unter http://officepowerups.com/help-support/excel-function-reference/excel-text-analyzer/pwrsimilarity/ .

Aber es funktioniert ziemlich gut, um Text in Spalte A mit Spalte B zu vergleichen.

Obwohl meine Lösung es nicht erlaubt, sehr unterschiedliche Zeichenfolgen zu identifizieren, ist sie für die teilweise Übereinstimmung (Teilzeichenfolgenübereinstimmung) nützlich, z. B. "Dies ist eine Zeichenfolge" und "eine Zeichenfolge" ergibt "Übereinstimmung":

Fügen Sie einfach "*" vor und nach der Zeichenfolge hinzu, um in die Tabelle zu suchen.

Übliche Formel:

• vlookup (A1, B1: B10,1,0)
• cerca.vert (A1; B1: B10; 1; 0)

wird

• vlookup ("*" & A1 & "*", B1: B10; 1,0)
• cerca.vert ("*" & A1 & "*"; B1: B10; 1; 0)

"&" ist die "Kurzversion" für verketten ()

Dieser Code scannt Spalte a und Spalte b, wenn er in beiden Spalten Ähnlichkeit findet, wird er gelb angezeigt. Sie können den Farbfilter verwenden, um den endgültigen Wert zu erhalten. Ich habe diesen Teil nicht in den Code eingefügt.

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