* Bonjour, *

Je souhaitais analyser des données saisies dans un fichier excel en utilisant un tableau croisé dynamique. Cependant, la liste des noms (angle principal d'analyse) a été saisie au fil de l'eau sous de nombreuses formes (M Dupont, M. DuPont, Mr Dupont, Laurent Dupont, M. Laurent Dupont, ...).
Ce n'est pas pratique pour regrouper toutes les lignes qui le devraient.
Je propose un code qui "néttoie" la liste des noms propres.

On peut :
  • nettoyer la liste en supprimant le "genre" (M,Mme, ...)
  • faire passer le prénom après le nom
  • supprimer le prénom
Les listes de préfixes à supprimer ou de prénoms gérés se modifient facilement dans le code. Faire juste attention à l'ordre de présentation dans la liste des prénoms : pour gérer "jean-luc" et "jean-louis" ... il faut les placer avant "jean" dans la liste des prénoms sinon il vous restera "-luc" ou "-louis" dans votre colonne !
[BR]Les paramètres decal_Lig et decal_col permettent de choisir entre un remplacement de la liste par la liste modifiée (paramètres à 0) ou la création d'une liste modifiée à decal_Lig lignes et/ou decal_col colonnes de la source.
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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
 
 
Sub Clean_nomP(Optional MaZone As Range, Optional PrenomApresT_SansF As Boolean = False, Optional Decal_Lig As Integer = 0, Optional Decal_Col As Integer = 0)
If MaZone Is Nothing Then Set MaZone = ActiveCell.CurrentRegion
Dim rg As Range, rgc As Range
Dim Mesprénoms(66) As String
Dim combien As Integer, i As Integer
combien = 66
 
GoTo Stock
Suite::
For Each rg In MaZone
    Set rgc = rg.Offset(Decal_Lig, Decal_Col)
    rgc.Value = Trim(rg.Value)
    rgc.Value = Application.WorksheetFunction.Clean(rgc.Value)
    rgc.Value = Replace(rgc.Value, "M.G", "M. G", 1)
    rgc.Value = Replace(rgc.Value, "M ", "", 1)
    rgc.Value = Replace(rgc.Value, "M. ", "", 1)
    rgc.Value = Replace(rgc.Value, "M, ", "", 1)
    rgc.Value = Replace(rgc.Value, "Mme ", "", 1)
    rgc.Value = Replace(rgc.Value, "Mme. ", "", 1)
    rgc.Value = Replace(rgc.Value, "MME ", "", 1)
    rgc.Value = Replace(rgc.Value, "MR ", "", 1)
    rgc.Value = Replace(rgc.Value, "Mr ", "", 1)
    rgc.Value = Trim(rgc.Value)
    For i = 1 To combien
        If PrenomApresT_SansF Then
            rgc.Value = Prénom_après(rgc.Value, Mesprénoms(i))
        Else
            rgc.Value = Application.WorksheetFunction.Clean(Trim(Replace(rgc.Value, Mesprénoms(i), "", 1)))
        End If
    Next i
    rgc.Value = UCase(rgc.Value)
Next rg
Exit Sub
Stock::
 
Mesprénoms(1) = "Agnès"
Mesprénoms(2) = "Alain"
Mesprénoms(3) = "Alban"
Mesprénoms(4) = "Alter"
Mesprénoms(5) = "Anne"
Mesprénoms(6) = "Annick"
Mesprénoms(7) = "Antoine"
Mesprénoms(8) = "Arlette"
Mesprénoms(9) = "Bertrand"
Mesprénoms(10) = "Brigitte"
Mesprénoms(11) = "Bruno"
Mesprénoms(12) = "Cath."
Mesprénoms(13) = "Cécile"
Mesprénoms(14) = "Christian"
Mesprénoms(15) = "Christian"
Mesprénoms(16) = "Christine"
Mesprénoms(17) = "Christophe"
Mesprénoms(18) = "Daniel"
Mesprénoms(19) = "Déborah"
Mesprénoms(20) = "Emily"
Mesprénoms(21) = "Emmanuel"
Mesprénoms(22) = "Eric"
Mesprénoms(23) = "Fabien"
Mesprénoms(24) = "Franck"
Mesprénoms(25) = "Frédérique"
Mesprénoms(26) = "Gilles"
Mesprénoms(27) = "Guillaume"
Mesprénoms(28) = "Henri"
Mesprénoms(29) = "Hubert"
Mesprénoms(30) = "J.A."
Mesprénoms(31) = "J.Bruno"
Mesprénoms(32) = "Jacques"
Mesprénoms(33) = "JB"
Mesprénoms(34) = "JC"
Mesprénoms(35) = "Jean Yves"
Mesprénoms(36) = "Jean Bruno"
Mesprénoms(37) = "Jean Christian"
Mesprénoms(38) = "Jean Jacques"
Mesprénoms(39) = "Jean Luc"
Mesprénoms(40) = "Jean"
Mesprénoms(41) = "Jérôme"
Mesprénoms(42) = "Julie"
Mesprénoms(43) = "Kenza"
Mesprénoms(44) = "Laurence"
Mesprénoms(45) = "Laurent"
Mesprénoms(46) = "Marine"
Mesprénoms(47) = "Michèle"
Mesprénoms(48) = "Nathalie"
Mesprénoms(49) = "Olivier"
Mesprénoms(50) = "Pascal"
Mesprénoms(51) = "Patricia"
Mesprénoms(52) = "Patrick"
Mesprénoms(53) = "Philippe"
Mesprénoms(54) = "Pierre"
Mesprénoms(55) = "Régine"
Mesprénoms(56) = "Savina"
Mesprénoms(57) = "Sophie"
Mesprénoms(58) = "Téresa"
Mesprénoms(59) = "Thierry"
Mesprénoms(60) = "Thomas"
Mesprénoms(61) = "Valérie"
Mesprénoms(62) = "Victor"
Mesprénoms(63) = "Virginie"
Mesprénoms(64) = "Wilfried"
Mesprénoms(65) = "William"
Mesprénoms(66) = "Yves"
 
GoTo Suite
End Sub
 
Function Prénom_après(Quoi As String, Prenom As String)
Prénom_après = Quoi
If UCase(Left(Quoi, Len(Prenom) + 1)) = UCase(Prenom + " ") Then
    Prénom_après = Trim(UCase(Right(Quoi, Len(Quoi) - Len(Prenom) - 1))) + " " + Prenom
End If
End Function
pour appeler la routine :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
 
Call Clean_nomP(Range("S1:S1000" ), False, 0, 1)
voire, tout simplement, avec le curseur / la selection dans la colonne à traiter :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
 
Clean_nomP
* Merci *