Confronto di stringhe di testo simili in Excel

Attualmente sto cercando di riconciliare i campi "Nome" da due origini dati separate. Ho un numero di nomi che non sono una corrispondenza esatta ma sono abbastanza vicini per essere considerati corrispondenti (esempi sotto). Hai idee su come posso migliorare il numero di partite automatizzate? Sto già eliminando le iniziali centrali dai criteri di corrispondenza.

Formula partita attuale:

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

Si consiglia di utilizzare il componente aggiuntivo Microsoft Fuzzy Lookup .

Dal sito MS:

Panoramica

Il componente aggiuntivo Ricerca fuzzy per Excel è stato sviluppato da Microsoft Research ed esegue la corrispondenza fuzzy di dati testuali in Microsoft Excel. Può essere utilizzato per identificare righe duplicate fuzzy all'interno di una singola tabella o per unire fuzzy righe simili tra due tabelle diverse. La corrispondenza è affidabile per un'ampia varietà di errori, inclusi errori di ortografia, abbreviazioni, sinonimi e dati aggiunti / mancanti. Ad esempio, potrebbe rilevare che le righe "Mr. Andrew Hill "," Hill, Andrew R. " e "Andy Hill" si riferiscono tutti alla stessa entità sottostante, restituendo un punteggio di somiglianza insieme ad ogni partita. Mentre la configurazione predefinita funziona bene per un'ampia varietà di dati testuali, come nomi di prodotti o indirizzi di clienti, la corrispondenza può anche essere personalizzata per domini o lingue specifici.

Vorrei esaminare questo elenco (solo la sezione inglese) per aiutare a eliminare gli accorciamenti comuni.

Inoltre, potresti prendere in considerazione l'utilizzo di una funzione che ti dirà, in termini esatti, quanto siano "vicine" due stringhe. Il seguente codice è venuto da qui e grazie a 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

Quello che farà è dirti quante inserzioni ed eliminazioni bisogna fare ad una stringa per arrivare all'altra. Vorrei provare a mantenere basso questo numero (e i cognomi dovrebbero essere esatti).

Ho una formula (lunga) che puoi usare. Non è così raffinato come quelli sopra - e funziona solo per cognome, piuttosto che per un nome completo - ma potresti trovarlo utile.

Quindi, se si dispone di una riga di intestazione e si desidera confrontare A2con B2, inserire questo in qualsiasi altra cella su quella riga (ad esempio, C2) e copiare fino alla fine.

= IF (A2 = B2, "ESATTO", IF (SOSTITUTIVO (A2, "-", "") = SOSTITUTIVO (B2, "-", ""), "Trattino", IF (LEN (A2)> LEN ( B2), IF (LEN (A2)> LEN (SOSTITUTIVO (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 (SOSTITUTIVO (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) e "°"))))

Questo restituirà:

• ESATTO - se è una corrispondenza esatta
• Trattino - se è una coppia di nomi a doppia canna ma su ha un trattino e l'altro uno spazio
• Tutta la stringa - se tutto il cognome fa parte dell'altro (ad esempio, se uno Smith è diventato un francese-Smith)

Dopodiché ti darà un grado da 0 ° a 6 ° a seconda del numero di punti di confronto tra i due. (vale a dire, 6 ° confronta meglio).

Come ho detto, un po 'ruvido e pronto, ma spero che ti porti all'incirca nel parco delle palle giusto.

Stava cercando qualcosa di simile. Ho trovato il codice qui sotto. Spero che questo aiuti al prossimo utente che arriva a questa domanda

Restituisce il 91% per Abracadabra / Abrakadabra, il 75% per Hollywood Street / Hollyhood Str, il 62% per Firenze / Francia e 0 per Disneyland

Direi che è abbastanza vicino a quello che volevi :)

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

È possibile utilizzare la funzione di somiglianza (pwrSIMILARITY) per confrontare le stringhe e ottenere una corrispondenza percentuale delle due. Puoi renderlo sensibile al maiuscolo / minuscolo. Dovrai decidere quale percentuale di una partita è "abbastanza vicina" per le tue esigenze.

C'è una pagina di riferimento su http://officepowerups.com/help-support/excel-function-reference/excel-text-analyzer/pwrsimilarity/ .

Ma funziona abbastanza bene per confrontare il testo nella colonna A con la colonna B.

Sebbene la mia soluzione non consenta di identificare stringhe molto diverse, è utile per la corrispondenza parziale (corrispondenza di sottostringa), ad esempio "questa è una stringa" e "una stringa" risulterà come "corrispondenza":

aggiungi "*" prima e dopo la stringa da cercare nella tabella.

Formula abituale:

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

diventa

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

"&" è la "versione corta" per concatenate ()

Questo codice esegue la scansione della colonna ae della colonna b, se rileva somiglianze in entrambe le colonne, viene visualizzato in giallo. È possibile utilizzare il filtro colore per ottenere il valore finale. Non ho aggiunto quella parte nel codice.

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