Discussion :

[Davbis]

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

[boisgontierjacques]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Sub GroupColor2CritèresColAColB()
  Set f = Sheets("feuil2")
  couleurs = Array(1, 3, 4, 6, 7, 8, 14, 15, 17, 20, 22, 24, 26, 27, 28, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 50, 53)
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("a2", f.[a65000].End(xlUp))
    clé = c.Value & sansTiret(c.Offset(, 1))
    mondico.Item(clé) = mondico.Item(clé) + 1
  Next c
  For Each c In f.Range("a2",f. [a65000].End(xlUp))
    clé = c.Value & sansTiret(c.Offset(, 1))
    nocoul = (Application.Match(clé, mondico.keys, 0)) Mod UBound(couleurs)
    If mondico.Item(clé) > 1 Then c.Resize(, 2).Interior.ColorIndex = couleurs(nocoul)
  Next c
End Sub
 
Function sansTiret(c)
  sansTiret = Application.Trim(Replace(c, "-", " "))
End Function

Boisgontier

[Davbis]

Bonjour,

Merci pour ta réponse rapide. Tu est vraiment au top.

Seulement comment as-tu fais ? Car quand je rajoute à ma liste des noms composés cela ne fonctionne pas. Ta macro fonctionne seulement pour la liste que je t'ai envoyé ?

Dans ce cas serait-il possible de le faire sur cette liste ?

[boisgontierjacques]

Il faut enregistrer le fichier au format macros.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Sub GroupColor2CritèresColAColB()
  Application.ScreenUpdating = False
  Set f = Sheets("feuil1")
  couleurs = Array(1, 3, 4, 6, 7, 8, 14, 15, 17, 20, 22, 24, 26, 27, 28, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 50, 53)
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("a2", f.[a65000].End(xlUp))
    clé = c.Value & "|" & sansTiret(c.Offset(, 1))
    mondico.Item(clé) = mondico.Item(clé) + 1
  Next c
  For Each c In f.Range("a2", f.[a65000].End(xlUp))
    clé = c.Value & "|" & sansTiret(c.Offset(, 1))
    If mondico.Item(clé) > 1 Then
       nocoul = (Application.Match(clé, mondico.keys, 0)) Mod UBound(couleurs)
       c.Resize(, 2).Interior.ColorIndex = couleurs(nocoul)
    End If
  Next c
  '-------------------liste sans doublons
  f.[i2].Resize(mondico.Count) = Application.Transpose(mondico.keys)
  f.[i2].Resize(mondico.Count).TextToColumns Other:=True, OtherChar:="|"
End Sub
 
Function sansTiret(c)
  sansTiret = Application.Trim(Replace(c, "-", " "))
End Function

Boisgontier

[Davbis]

Tu gères grave.

À quoi sert la colonne I et J s'il te plait ?

Merci à toi

PS : Quand je clique sur "GO", on me dit : Cette cellule contient des données. Voulez-vous les remplacer ?. C'est normal ?

[boisgontierjacques]

A quoi sert la colonne I et J s'il te plait ?

c'est pour obtenir la liste sans doublons.

PS : Quand je clique sur "GO", on me dit : Cette cellule contient des données. Voulez-vous les remplacer ?. C'est normal ?

Pour supprimer ce message, ajouter avant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.DisplayAlerts=False

Boisgontier

[Davbis]

Merci à toi !

Je mets le sujet en résolu