Doublons approchants

dadoubis

XLDnaute Nouveau
Bonjour à tous !

J'ai besoin de votre aide.

Je possède un annuaire d'environ 30 000 lignes. Il contient plusieurs champs. Ceux qui m’intéresse sont les Noms et Prénoms.

Y a t-il un moyen de faire une analyse sur les noms et prénoms approchants ( composé, avec tiret, avec accent etc) ?

Ci-joint le fichier Excel avec 2 noms et prénoms composé et non composé (en réalité il s’agit bien de la même personne).

Mon objectif serait que dans la colonne C, on m’indique pour les lignes en questions “Problème“, sinon “Ok“.

Je ne sais pas si cela est possible, peut-être l’utilisation d’une macro serait dans ce cas primordiale.

J’espère que quelqu’un d’entre vous aurez une solution à me proposer.

Merci à vous
 

Pièces jointes

  • davbis (4).xlsx
    10.5 KB · Affichages: 35

dadoubis

XLDnaute Nouveau
Non malheureusement ce n'est pas efficace :(

Par exemple pour la ligne 36 (fichier ci joint), il n'y a ni nom composé ni espace et pourtant il me le met en MFC. Je ne sais d'ailleurs pas sur quoi il se fie.

As-tu une idée ?

Merci
 

Pièces jointes

  • dav.xlsx
    1.4 MB · Affichages: 30

job75

XLDnaute Barbatruc
Re,

Dans le fichier joint :

- les doublons "normaux" ne sont plus retenus grâce à la colonne D (2ème concaténation)

- la MFC est remplacée par la colonne E avec cette formule en E2 :
Code:
=REPT("Problème";SI(NB.SI(C:C;C2)>1;NB.SI(D:D;D2)=1))
Il suffit de filtrer la colonne E sur "Problème".

Mais le recalcul des formules prend beaucoup de temps, il faudra du VBA pour y remédier.

A+
 

Pièces jointes

  • dav formules(1).xlsx
    2 MB · Affichages: 27
Dernière édition:

job75

XLDnaute Barbatruc
Re,

Donc voici une solution VBA avec cette macro pour renseigner la colonne C (à filtrer) :
Code:
Sub MAJ()
Dim t, a$(), d1 As Object, d2 As Object, i&, x$, y$
With [A1].CurrentRegion.Resize(, 2)
    t = .Value 'matrice, plus rapide
    ReDim a(1 To UBound(t), 1 To 1)
    Set d1 = CreateObject("Scripting.Dictionary")
    d1.CompareMode = vbTextCompare 'la casse est ignorée
    Set d2 = CreateObject("Scripting.Dictionary")
    d2.CompareMode = vbTextCompare 'la casse est ignorée
    '---remplissage des Dictionary---
    For i = 2 To UBound(t)
        x = t(i, 1) & t(i, 2)
        y = Replace(Replace(x, "-", ""), " ", "")
        d1(y) = d1(y) + 1 'comptage
        d2(x) = d2(x) + 1 'comptage
    Next
    '---remplissage du tableau a---
    a(1, 1) = "Problème" 'titre
    For i = 2 To UBound(t)
        x = t(i, 1) & t(i, 2)
        If d1(Replace(Replace(x, "-", ""), " ", "")) > 1 Then If d2(x) = 1 Then a(i, 1) = "Problème"
    Next
    '---restitution en colonne C---
    .Columns(3) = a
End With
End Sub
Elle est rapide car elle utilise des Dictionary et des tableaux VBA.

Fichier .xlsm joint.

A+
 

Pièces jointes

  • dav VBA(1).xlsm
    748.2 KB · Affichages: 28

dadoubis

XLDnaute Nouveau
Re,

Dans le fichier joint :

- les doublons "normaux" ne sont plus retenus grâce à la colonne D (2ème concaténation)

- la MFC est remplacée par la colonne E avec cette formule en E2 :
Code:
=REPT("Problème";SI(NB.SI(C:C;C2)>1;NB.SI(D:D;A2&B2)=1))
Il suffit de filtrer la colonne E sur "Problème".

Mais le recalcul des formules prend beaucoup de temps, il faudra du VBA pour y remédier.

A+

Tu es juste génial..

Merci à toi pour ce que tu fais, peu de personnes sont généreuses comme toi aujourd'hui.
Merci !
 

dadoubis

XLDnaute Nouveau
Re,

Donc voici une solution VBA avec cette macro pour renseigner la colonne C (à filtrer) :
Code:
Sub MAJ()
Dim t, a$(), d1 As Object, d2 As Object, i&, x$, y$
With [A1].CurrentRegion.Resize(, 2)
    t = .Value 'matrice, plus rapide
    ReDim a(1 To UBound(t), 1 To 1)
    Set d1 = CreateObject("Scripting.Dictionary")
    d1.CompareMode = vbTextCompare 'la casse est ignorée
    Set d2 = CreateObject("Scripting.Dictionary")
    d2.CompareMode = vbTextCompare 'la casse est ignorée
    '---remplissage des Dictionary---
    For i = 2 To UBound(t)
        x = t(i, 1) & t(i, 2)
        y = Replace(Replace(x, "-", ""), " ", "")
        d1(y) = d1(y) + 1 'comptage
        d2(x) = d2(x) + 1 'comptage
    Next
    '---remplissage du tableau a---
    a(1, 1) = "Problème" 'titre
    For i = 2 To UBound(t)
        x = t(i, 1) & t(i, 2)
        If d1(Replace(Replace(x, "-", ""), " ", "")) > 1 Then If d2(x) = 1 Then a(i, 1) = "Problème"
    Next
    '---restitution en colonne C---
    .Columns(3) = a
End With
End Sub
Elle est rapide car elle utilise des Dictionary et des tableaux VBA.

Fichier .xlsm joint.

A+

J'ai réussi à filtrer sans la VBA :p