recherche de doublons

[apfwl.87]

Bonjour à tous

J'ai un fichier (A) avec des clients, qui sont soit des personnes privées soit des entreprises, des écoles ou des associations. J'ai un autre fichier (B) contenant également des données clients. Afin d'éviter d'avoir le client à double, j'aimerais faire une recherche entre A et B et ne garder que les clients du fichier B qui ne sont pas déjà dans le fichier A.

Le problème, c'est que le nom est parfois écrit d'une manière dans A et d'une autre dans B et quand j'écris ma formule de recherche et bien évidemment il ne trouve pas le client. Est-ce qu'il existe un moyen de trouver les doublons avec une partie de texte?

Exemple:
Fichier A, ligne 1: Ecole primaire deCharmey
Fichier B, ligne 30: Ecole de Charmey

ou encore
Fichier A, ligne 10: Entreprise de récupération
Fichier B, ligne 100: Entr. de Récup.

Merci d'avance pour votre aide.

 

[pascal21]

Re : recherche de doublons

bonjour
sur le site de JB, tout ou presque sur la gestion des doublons
sinon avec une liste déroulante de ta liste tu éviteras les erreurs d'écriture de la recherche
et avec cette proposition de JB (oui je sais encore lui, on peut pas lutter, il a écrit une véritable bible de excel)

 

[BOISGONTIER]

Re : recherche de doublons

Bonjour,

Voir fonction perso Proche() en pj

Function Proche(DemClient, cata As Range)
  Set dMotsCat = CreateObject("Scripting.Dictionary")
  Set dref = CreateObject("Scripting.Dictionary")
  i = 1
  For Each c In cata
    dref(CStr(i)) = c.Value
    For Each m In Split(Trim(c.Value), " ")
      dMotsCat(sansAccent(LCase(m))) = dMotsCat(sansAccent(LCase(m))) & CStr(i) & " "
    Next m
    i = i + 1
  Next c
  DemClient = sansAccent(SansPoint(LCase(DemClient)))
  Set dDemClient = CreateObject("Scripting.Dictionary")
  For Each m In Split(DemClient, " ")
    tem = False
    For Each i In dMotsCat.keys
      If i Like m & "*" Then
        tem = True
        Exit For
      End If
    Next i
     If tem Then
      For Each ref In Split(Trim(dMotsCat(i)), " ")
        dDemClient(ref) = dDemClient(ref) + 1
      Next ref
    End If
  Next m
  '-- recherche maxi dans dDemClient
  If dDemClient.Count > 0 Then
   Maxi = Application.Max(dDemClient.items)
   MeilNotePourc = 0
   For Each ref In dDemClient.keys
     If dDemClient(ref) = Maxi Then
        notePourc = Maxi / (UBound(Split(dref(ref), " ")) + 1)
        If notePourc > MeilNotePourc Then
           MeilNotePourc = notePourc
           RefMeilNote = ref
           meilNote = Maxi & "/" & (UBound(Split(Trim(dref(ref)), " ")) + 1)
        End If
     End If
   Next ref
   Proche = dref(RefMeilNote) '& " [" & meilNote & "]"
  Else
   Proche = ""
  End If
End Function

Function SansPoint(chaine)
  a = Split(chaine, " ")
  For i = LBound(a) To UBound(a)
    If Right(a(i), 1) = "." Then a(i) = Left(a(i), Len(a(i)) - 1)
  Next i
  SansPoint = Join(a, " ")
End Function

Function sansAccent(chaine)
   codeA = "ÉÈÊËÔéèêëàçùôûïî"
   codeB = "EEEEOeeeeacuouii"
   temp = chaine
   For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
   Next
   sansAccent = temp
End Function

JB

 

[apfwl.87]

Re : recherche de doublons

Bonsoir pascal 21 et boisgontier, désolée de ne pas vous avoir répondu plus tôt. J'étais absente plusieurs jours et je ne poouvais pas consulter mes mails. merci pour vos réponse. Je vais tester ça dès demain. Merci à tous les deux pour votre aide.