J'essaie actuellement de réconcilier les champs "Nom" de deux sources de données distinctes. J'ai un certain nombre de noms qui ne correspondent pas exactement mais qui sont suffisamment proches pour être considérés comme identiques (exemples ci-dessous). Avez-vous une idée de la façon dont je pourrais améliorer le nombre de correspondances automatisées? J'élimine déjà les initiales du milieu des critères de correspondance.
Formule de correspondance actuelle:
=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")
Vous pouvez envisager d’utiliser le complément Microsoft Fuzzy Lookup .
Depuis le site MS:
Vue d'ensemble
Le complément de recherche floue pour Excel a été développé par Microsoft Research et effectue une correspondance floue de données textuelles dans Microsoft Excel. Il peut être utilisé pour identifier des lignes dupliquées floues dans une seule table ou pour joindre des lignes similaires entre deux tables différentes. La correspondance est robuste pour une grande variété d'erreurs, notamment les fautes d'orthographe, les abréviations, les synonymes et les données ajoutées/manquantes. Par exemple, il peut détecter que les lignes “M. Andrew Hill "," Hill, Andrew R. "et" Andy Hill "font tous référence à la même entité sous-jacente, renvoyant un score de similarité à chaque match. Bien que la configuration par défaut fonctionne bien pour une grande variété de données textuelles, telles que les noms de produits ou les adresses de clients, la correspondance peut également être personnalisée pour des domaines ou des langues spécifiques.
Je chercherais à utiliser cette liste (section anglaise uniquement) pour aider à éliminer les raccourcissements courants.
En plus, vous voudrez peut-être envisager d’utiliser une fonction qui vous dira, en termes exacts, à quel point deux chaînes sont "proches". Le code suivant provient de ici et grâce à 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
Cela vous indiquera le nombre d'insertions et de suppressions que l'on doit faire sur une chaîne pour atteindre l'autre. J'essayerais de garder ce nombre bas (et les noms de famille devraient être exacts).
J'ai une (longue) formule que vous pouvez utiliser. Ce n'est pas aussi parfait que ceux mentionnés ci-dessus - et ne fonctionne que pour le nom de famille, plutôt que pour un nom complet - mais vous pourriez le trouver utile.
Ainsi, si vous avez une ligne d’en-tête et souhaitez comparer A2
avec B2
, placez-la dans une autre cellule de cette ligne (par exemple, C2
) et copiez-la jusqu'à la fin.
= SI (A2 = B2, "EXACT", SI (SUBSTITUT (A2, "-", "") = SUBSTITUT (B2, "-", ""), "Trait d'union", SI (LEN (A2)> LEN ( B2), IF (LEN (A2)> LEN (SUBSTITUT (A2, B2, ""))), "Chaîne entière", 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) & "°"), SI (LEN (B2)> LEN (SUBSTITUT (B2, A2, ""))), "Chaîne entière", SI (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) & "°"))))
Cela retournera:
Après cela, vous obtiendrez un degré de 0 ° à 6 ° en fonction du nombre de points de comparaison entre les deux. (c'est-à-dire que 6 ° se compare mieux).
Comme je le disais un peu rude et prêt, mais j'espère que vous obtenez à peu près le bon terrain de base-ball.
Je cherchais quelque chose de similaire. J'ai trouvé le code ci-dessous. J'espère que cela aidera le prochain utilisateur qui vient à cette question
Rend 91% pour Abracadabra/Abrakadabra, 75% pour Hollywood Street/Hollyhood Str, 62% pour Florence/France et 0 pour Disneyland
Je dirais que c'est assez proche de ce que tu voulais :)
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
Ce code analyse la colonne a et la colonne b, s’il trouve une similarité dans les deux colonnes, il apparaît en jaune. Vous pouvez utiliser le filtre de couleur pour obtenir la valeur finale. Je n'ai pas ajouté cette partie dans le code.
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
Vous pouvez utiliser la fonction de similarité (pwrSIMILARITY) pour comparer les chaînes et obtenir un pourcentage de correspondance des deux. Vous pouvez le rendre sensible à la casse ou non. Vous aurez besoin de décider quel pourcentage d'une correspondance est "assez proche" pour vos besoins.
Il y a une page de référence à http://officepowerups.com/help-support/Excel-function-reference/Excel-text-analyzer/pwrsimilarity/ .
Mais cela fonctionne plutôt bien pour comparer le texte de la colonne A à la colonne B.
Bien que ma solution ne permette pas d’identifier des chaînes très différentes, elle est utile en cas de correspondance partielle (correspondance de sous-chaîne), par exemple. "ceci est une chaîne" et "une chaîne" donnera "correspondant":
ajoutez simplement "*" avant et après la chaîne à rechercher dans la table.
Formule habituelle:
devient
"&" est la "version courte" pour concaténer ()