Récupérer liste de noms pour associer nom (format different)

**Akre6** · 20/04/2015, 10h28

Bonjour,
Alors je cherche à améliorer ma macro que j'ai présenté sur le lien suivant:
http://www.developpez.net/forums/d15...rie-processus/

Bon comme j'ai mis résolu, je me permet de créer un autre sujet. Je butte sur un point... J'ai cherché sur google et sur le forum mais j'ai pas trouvé. J'ai peut-être taper de mauvais mot clés.

Alors j'aimerai que lorsque l'opérateur choisie un nom de chef de section dans un menu déroulant, ceci l'associé à la section, puis à une liste de nom sous la forme:

B.CHEF (nom du chef)
TEAM (nom de l'équipe)
M.Dupont
J.Truc
L.Bidule

Avec cette liste, je vais chercher dans une feuille (disons "Data"), les lignes telle que sur la colonne A, le nom fasse partie de la liste associé au dessus...
Mais dans cette colonne, les noms sont de la forme:
"M. Michel Dupont" ou "Mlle Julie Truc"

Donc pour résumer, la macro doit en fonction du nom donné dans une feuille, récupérer une liste, où à partir de la 3eme ligne figurent les noms des membres de l'équipe. A partir des ces noms, aller dans une autre feuille, récupérer les lignes, mais les noms sont dans un format différent.
Pour récupérer le nom de famille de pensais utiliser "right", puis "left" pour le prénom (histoire de verifier que la lettre correspond bon bien au nom dans l'autre feuille).

EDIT:
Bon j'ai avancé mais j'ai quand même du mal... Je cherche maintenant à travailler qu'avec les membres de l'équipe selectioné.
Du coup, je dois trier la première colonne, prendre uniquement ceux dans ma liste, mais dans la suite j'ai déjà pas mal de condition, et du coup ça devient pénible.
Alors je me demande s'il vaut mieux pas créer un worksheet avec les données des membres que je veux étudié (en les copiant)

**Akre6** · 21/04/2015, 14h40

UP !

Voilà ma macro... J'ai un gros soucis avec la condition Cellnom admet comme string, le nom de famille... Il y a une erreur d'incontabilité et je comprends pas.
Cellnom correspond bien à une chaine de carractère...

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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
 
Option Explicit
 
Sub Imputation()
 
'Declaration des variables
 
Dim CellActive As Range
Dim Celltowrite As Range
Dim Cell_test As Range
Dim celluletrouvee As Range
Dim Cell As Range, Cellnom As Range
Dim Plage As Range, Plage_nom As Range
Dim Membre As Range
 
 
Dim FSource As Worksheet
Dim FCible As Worksheet
Dim FCible_bis As Worksheet
Dim Feuille As Worksheet
 
Dim Un As Collection
Dim Deux As Collection
 
 
 
Dim ssdoublon()
Dim Tableau()
 
Dim Section As String
Dim Nom As String
Dim Description As String
Dim Nom_bis As String
Dim Tampon As Long
 
Dim dl As Long, dl_bis As Long
Dim Heure As Long
Dim Dec As Long
Dim Sum As Long
Dim Colonne As Long
Dim b As Long
Dim i As Long, n_ligne As Long, a As Long
Dim num_ligne As Long
 
 
 
 
'On récupère les valeurs données par l'opérateur
'Feuille Source
Set FSource = Worksheets("Cmd")
Section = FSource.Range("B2").Value
 
 
For i = 1 To Worksheets.Count
    If Worksheets(i).Name = Section Then
        Sheets(Section).Delete
    End If
Next i
 
Sheets.Add Worksheets(1)
Sheets(1).Name = Section
 
Set FCible_bis = Worksheets(Section)
 
'On récupère la liste des membres
Set FCible = Worksheets("Ar_plan")
 
'On va parcourir la liste des sections
Set celluletrouvee = FCible.Range("A2:Z2").Find(Section, LookAt:=xlWhole)
 
If celluletrouvee Is Nothing Then
MsgBox ("Pas trouvé de section")
Else
Colonne = celluletrouvee.Column
End If
 
'On va parcourir la liste des membres
b = 0
 
Set Plage = FCible.Range(celluletrouvee, celluletrouvee.End(xlDown)).Rows
For Each Membre In Plage
   Nom = Membre.Value
   'MsgBox (Membre.Value)
 
'On formate le nom
Nom_bis = Mid(Nom, 3, Len(Nom))
 
    FSource.Cells(20 + b, 20) = Nom_bis
 
 
'On va chercher les valeurs données
'Feuille Cible
    Set FCible = Worksheets("DATA")
 
 
 Set Plage = FCible.Columns("A")
 
 For Each Cellnom In Plage
 
   If Cellnom.Value Like ("*" & Nom_bis & "*") Then
   ' If InStr(1, Cellnom.Value, Nom_bis) > 0 Then
        MsgBox ("BRAVO")
        FCible.Rows(Cellnom.Row).Copy Destination:=FCible_bis.Cells(num_ligne, 1)
        num_ligne = num_ligne + 1
    End If
 Next Cellnom
 
 
'On va prendre uniquement les membres de la section
 
With ActiveSheet
   dl = FCible.Range("D" & .Rows.Count).End(xlUp).Row
End With
 
Set Plage = FCible.Range("D2:D" & dl)
Set Un = New Collection
On Error Resume Next
 
'On parcourt la plage de donnée
For Each Cell In Plage
   If Cell <> "" Then Un.Add Cell, CStr(Cell) 'Si la valeur est différent des autres on la prends sinon on passe
Next Cell
 
 
 
 
For i = 1 To Un.Count
   ReDim Preserve ssdoublon(i - 1)
   ssdoublon(i - 1) = Un.Item(i)
  Next i
 
Heure = 0 'on inialise
 
For i = 0 To UBound(ssdoublon)
  ' MsgBox ssdoublon(i)
  ' à la place remplis ta listbox
  'On ecrit le projet sur notre ligne de sortie
n_ligne = 2
 
'Set Celltowrite = FSource.Cells(n_ligne, 1)
FSource.Cells(n_ligne + i, 5) = ssdoublon(i)
 
Sum = 0 'on initalise
For Each Cell In Plage
If Cell = ssdoublon(i) Then Sum = Sum + Cell.Offset(0, 2).Value
 
'Si le projet est le bon on récupère son heure
If Cell = ssdoublon(i) Then Description = Cell.Offset(0, 1).Value
Next Cell
 
'On écrit la somme des heures travaillées sur un projet
FSource.Cells(n_ligne + i, 6) = Description
FSource.Cells(n_ligne + i, 7) = Sum
 
'On somme les heures (pour avoir la somme des heures totales)
Heure = Heure + Sum
 Next i
 
'On écrit la somme des heures travaillées
FSource.Cells(n_ligne + i, 7) = Heure
 
For a = 0 To i
 
'On caclule les pourcentages et on l'écrit
FSource.Cells(n_ligne + a, 8) = FSource.Cells(n_ligne + a, 7) / Heure
 
'On calcule le nombre d'heure à impuer et on l'écrit
FSource.Cells(n_ligne + a, 9) = FSource.Cells(n_ligne + a, 8) * FSource.Cells(2, 3)
 
'On va arrondir les valeurs
FSource.Cells(n_ligne + a, 10) = Round(FSource.Cells(n_ligne + a, 9))
Next a
 
Sum = 0
Heure = 0
 
'On va calculer les sommes
For a = 0 To i - 1
Sum = Sum + FSource.Cells(n_ligne + a, 8)
Heure = Heure + FSource.Cells(n_ligne + a, 9)
Next a
'On les écrit
FSource.Cells(a + 2, 9) = Sum
FSource.Cells(a + 2, 9) = Heure
FSource.Cells(a + 2, 5) = "Total"
 
 
Set Un = Nothing
 
 
'On passe à la personne suivante
b = b + 1
Next Membre
 
End Sub

**Akre6** · 22/04/2015, 09h00

Désolé pour le triple message, j'ai résolu le problème initiale mais j'ai deux questions...

Je demande d'effacer la feuille "tampon" si elle existe, mais à chaque fois qu'il l'efface il plante (disant que la variable de la boucle for du début qui permet de supprimer la feuille ne fait pas parti de la selection), donc je dois lancer deux fois le programme.

Puis pour la fin je dois ranger mon tableau (de 6 Colonnes) par ordre croissant en fonction d'une colonne... Je me demandais s'il y avait quelque chose d'assez optimal...
Parce que la je vois que:
-prendre le tableau dans la feuille tampo,
-étudier ligne par ligne le max
-couper/coller la ligne du max
-recommencer

EDIT:
FINI

Je me la macro si vous avez des conseils à me donner vu que je suis assez novice

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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
 
Option Explicit
 
Sub Imputation()
 
'Declaration des variables
 
Dim CellActive As Range
Dim Celltowrite As Range
Dim Cell_test As Range
Dim celluletrouvee As Range
Dim Cell As Range, Cellnom As Range
Dim Plage As Range, Plage_nom As Range
Dim Membre As Range
 
 
Dim FSource As Worksheet
Dim FCible As Worksheet
Dim FCible_bis As Worksheet
Dim Feuille As Worksheet
 
Dim Un As Collection
Dim Deux As Collection
 
 
 
Dim ssdoublon()
 
Dim Section As String
Dim Nom As String
Dim Description As String
Dim Nom_bis As String
Dim Tampon As Long
 
Dim dl As Long, dl_bis As Long
Dim Heure As Long
Dim Dec As Long
Dim Sum As Long
Dim Colonne As Long
Dim b As Long
Dim i As Long, n_ligne As Long, a As Long
Dim num_ligne As Long
Dim Max As Long
 
Dim NoLig As Long, Var As Variant
Dim NoCol As Integer
 
 
'On récupère les valeurs données par l'opérateur
'Feuille Source
Set FSource = Worksheets("Cmd")
Section = FSource.Range("B2").Value
 
'Pour eviter les alertes
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
 
'On récupère le nom de la section
Sheets.Add Worksheets(1)
'On crée la feuille tampon
Sheets(1).Name = "tampon"
Set FCible_bis = Worksheets("tampon")
 
'On récupère la liste des membres
Set FCible = Worksheets("Ar_plan")
 
'On va parcourir la liste des sections
Set celluletrouvee = FCible.Range("A2:Z2").Find(Section, LookAt:=xlWhole)
 
If celluletrouvee Is Nothing Then
MsgBox ("Pas trouvé de section")
Else
Colonne = celluletrouvee.Column
End If
 
'On va parcourir la liste des membres
b = 0
 
Set Plage = FCible.Range(celluletrouvee, celluletrouvee.End(xlDown)).Rows
For Each Membre In Plage
   Nom = Membre.Value
   'MsgBox (Membre.Value)
 
'On formate le nom
Nom_bis = Mid(Nom, 3, Len(Nom))
 
    FSource.Cells(20 + b, 20) = Nom_bis
 
'On va prendre uniquement les membres de la section
'Feuille Cible
    Set FCible = Worksheets("DATA")
'On initalise
num_ligne = 1
NoCol = 1 'lecture de la colonne 1
 
'On parcourt tous les noms
    For NoLig = 1 To FCible.UsedRange.Rows.Count
        Var = FCible.Cells(NoLig, NoCol)
'Si le nom correspond à un membre de l'équipe alors on copie la ligne
       If Var Like ("*" & Nom_bis & "*") Then
        FCible.Rows(NoLig).Copy Destination:=FCible_bis.Cells(num_ligne, 1)
        num_ligne = num_ligne + 1
        End If
    Next
'On passe à la personne suivante
b = b + 1
num_ligne = num_ligne + 1
Next Membre
 
 
 
'On va étudier les études de la section
Set FCible = Worksheets("tampon")
 
'On efface les données précédentes
FSource.Range("E:J").Clear
 
'On associe les valeurs à nos colonnes
FSource.Cells(1, 5) = "NOM OTP"
FSource.Cells(1, 6) = "Description"
FSource.Cells(1, 7) = "Heure d'étude"
FSource.Cells(1, 8) = "Pondération"
FSource.Cells(1, 9) = "Heure à imputer"
FSource.Cells(1, 10) = "Arrondi"
 
'On cherche la dernière ligne
With ActiveSheet
   dl = FCible.Range("D" & .Rows.Count).End(xlUp).Row
End With
'On défini la nouvelle plage
Set Plage = FCible.Range("D1:D" & dl)
Set Un = New Collection
On Error Resume Next
 
'On parcourt la plage de donnée
'On réalise le liste des études sans doublon
For Each Cell In Plage
   If Cell <> "" And Not IsEmpty(Cell) Then Un.Add Cell, CStr(Cell) 'Si la valeur est différent des autres on la prends sinon on passe
Next Cell
 
For i = 0 To Un.Count
   ReDim Preserve ssdoublon(i)
   ssdoublon(i) = Un.Item(i)
  Next i
 
Heure = 0 'on inialise
 
For i = 0 To UBound(ssdoublon)
If ssdoublon(i) Like "*.*" Then
  ' à la place remplis ta listbox
  'On ecrit le projet sur notre ligne de sortie
n_ligne = 1
 
FCible_bis.Cells(n_ligne + i, 10) = ssdoublon(i)
 
Sum = 0 'on initalise
For Each Cell In Plage
If Cell = ssdoublon(i) Then Sum = Sum + Cell.Offset(0, 2).Value
'Si le projet est le bon on récupère son heure
If Cell = ssdoublon(i) Then Description = Cell.Offset(0, 1).Value
Next Cell
 
 
'On écrit la somme des heures travaillées sur un projet
FCible_bis.Cells(n_ligne + i, 11) = Description
 
FCible_bis.Cells(n_ligne + i, 12) = Sum
 
'On somme les heures (pour avoir la somme des heures totales)
Heure = Heure + Sum
End If
 Next i
 
 
'On va trier ce tableau
 
    FCible_bis.Range("J:L").Select
    Selection.Sort Key1:=Range("L2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
b = 2
For NoLig = 1 To FCible_bis.Range("J1").End(xlDown).Row
FCible_bis.Cells(NoLig, 10).Copy Destination:=FSource.Cells(b, 5)
FCible_bis.Cells(NoLig, 11).Copy Destination:=FSource.Cells(b, 6)
FCible_bis.Cells(NoLig, 12).Copy Destination:=FSource.Cells(b, 7)
b = b + 1
Next NoLig
 
 
 
For a = 0 To i - 1
 
'On caclule les pourcentages et on l'écrit
FSource.Cells(n_ligne + a, 8) = FSource.Cells(n_ligne + a, 7) / Heure
 
'On calcule le nombre d'heure à impuer et on l'écrit
FSource.Cells(n_ligne + a, 9) = FSource.Cells(n_ligne + a, 8) * FSource.Cells(2, 3)
 
'On va arrondir les valeurs
FSource.Cells(n_ligne + a, 10) = Round(FSource.Cells(n_ligne + a, 9))
Next a
 
Sum = 0
Heure = 0
 
'On va calculer les sommes
For a = 1 To FSource.Range("E1").End(xlDown).Row - 1
Sum = Sum + FSource.Cells(n_ligne + a, 7)
Heure = Heure + FSource.Cells(n_ligne + a, 10)
Next a
 
 
'On les écrit
FSource.Cells(a + 1, 7) = Sum
FSource.Cells(a + 1, 10) = Heure
FSource.Cells(a + 1, 5) = "Total"
 
 
Set Un = Nothing
 Sheets("tampon").Delete
Application.ScreenUpdating = True
 
End Sub

Récupérer liste de noms pour associer nom (format different)

Macros et VBA Excel

Discussions similaires

Partager

Partager