mettre plusieurs valeurs dans une cellule

**mgrizzly** · 14/05/2009, 15h30

Bonjour,
Je fais un planning pour gérer les agents. J'ai une feuille "mois en cours" avec un calandrier où les weekend et jours fériés sont mis en jaune et une autre feuille "compétences", où on trouve un tableau des agents et de leurs compétences:
colonne 1: id des agents
colonne 2: nom des agents
colonne 3 juqu'à colonne 9: compétences des agents marqués avec des 1 et des 0 pour sachant faire et ne sachant pas faire.
J'ai un code qui prend aléatoirement 3 agents de la ligne 9 à 24, 3 agents de la ligne 25 à 42 et 3 agents de la ligne 43 à 59, sauf les cellules colorés en rouge (agent en congés).
Je voudrais que le code puisse prendre ces 9 agents et les mettre dans chaque cellules blanches de la feuille "mois en cours" de la cellule F4 à F34.
Sauf que mon code rempli bien les cellules de F4 à F34 mais ne met qu'1 nom d'agent au lieu des 9 dans une cellule.
Merci de m'aider. J'espère avoir été clair!

Voici mon code :

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
Sub FIP_AIP_MUSC_3() 
 
Dim i As Byte, y() As Variant, z() As Variant, x As Integer, c As New Collection 
Dim p As Range, v As Byte, w(8) As String 
Randomize 
y = Array(16, 17, 18) 
z = Array(9, 25, 42) 
For i = 0 To 2 
Do While c.Count < 3 
x = Int(y(i) * Rnd + z(i)) 
If Cells(x, 3) = 1 And Cells(x, 3).Interior.ColorIndex <> 3 Then 
On Error Resume Next 
c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address) 
If Err = 0 Then 
On Error GoTo 0 
w(v) = Cells(x, 2).Value 
v = v + 1 
End If 
On Error GoTo 0 
End If 
Loop 
Set c = Nothing 
Next i 
v = 0 
For Each p In Sheets("Mois en cours").Range("F4:F34") 
If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then 
p.Value = w(v) 
v = IIf(v = 8, 0, v + 1) 
End If 
Next p 
 
End Sub

**Krovax** · 14/05/2009, 15h39

Ce que je ne comprend pas c'est ce que tu entend par mettre plusieur nom dans une cellule.
Tu veux mettre les nom a la suite dans la meme celule? A la ligne?
J'ai pas trop chercher a lire ton code sans les balise

c'est pas ennuyeux a lire (pour rester polis

)

Pour ajouter des infos a la ligne dans une cellule tu peux essayer d'apater

Code :

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

1
2
a="ligne suivante"
cells(1,1)=cells(1,1) & chr(10) & a

Edit : entre temps tu a rajouté les balise
Si j'ai bien compris avant d'écrire le nom de l'agent tu vérifies que la cellule soit vide. Une fois que tu as mis le premier nom. Elle ne l'ai plus et du coup ton test n'est plus bon

Code :

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

If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then

essaye de mettre ca

Code :

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

1
2
3
4
5
6
7
If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then 
p.Value = w(v) 
v = IIf(v = 8, 0, v + 1) 
elseIf p.Interior.ColorIndex <> 6  Then 
p.Value =p.value & chr(10) & w(v) 
v = IIf(v = 8, 0, v + 1) 
End If

**mgrizzly** · 14/05/2009, 15h44

Je voudrais mettre les 9 noms trouvés parle programme dans les cellules dans la feuille "mois en cours" et dans chaque cellule de la colonne F4 à F34.
Je voudrais que ces noms soient espacés pour bien pouvoir les lire.

**Krovax** · 14/05/2009, 15h50

J'ai édité mon post avec une solution.
Tu peux remplacer chr(10) par " "

**mgrizzly** · 14/05/2009, 15h59

Ton code ne marche pas, je n'ai toujours qu'un nom au lieu de 9 dans les cellules.

**Krovax** · 14/05/2009, 16h09

Essayons de rester politiquement correcte et de dire "ton code ne semble pas adapter a la situation" au mlieu de "Ca marche pas" qui pourrais vexer.

En mode pas a pas tu entre dans la deuxième partie de mon If?
Le nom qui s'inscrit c'est le premier ou le dernier des 9 noms?

**mgrizzly** · 14/05/2009, 16h23

Désolé Krovax mais ce code m'énerve ça fait toute la journée que je suis dessus et merci beaucoup de m'aider! J'ai fait pas à pas et ça marche.
Mais toujours pas 9 noms dans mes cellules mais 1 seul.
Les 9 noms s'étalent sur 9 lignes et recommencent avec les mêmes noms jusqu'à arriver en F34.
Ce n'est pas ce que je veux!

Je voudrais que ces 9 noms ce mettent dans une cellule et qu'à la cellule suivante on aurait de nouveau 9 noms mais pas les même et cela jusqu'en F34.

**Krovax** · 14/05/2009, 16h31

en même temps tu ne lui demande pas al moitié de ce que tu dit

Code :

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

1
2
3
4
5
6
7
8
9
 
For Each p In Sheets("Mois en cours").Range("F4:F34") 
If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then 
p.Value=w(0)
for v=1 to 8 
p.Value =p.value & chr(10) &  w(v) 
next v
End If 
Next p

ca devrais mieu fonctionner (je part du principe que tu a déjà vérifier que le tableau w contient bient 9 noms
tu peux remplacer chr(10) par " "

ps : j'ai enlever le v = IIf(v = 8, 0, v + 1), je n'ai pas trop compris ce que ca venais faire la

**mgrizzly** · 14/05/2009, 16h39

Super!!! ça écrit bien 9 noms dans les cellules

Maitenent plus que 2 petits problèmes à régler:
- les 9 noms s'écrivent bien dans les cellules mais c'est toujours les mêmes, je voudrais en tirer d'autres aléatoirement pour chaque cellules qui suivent.
- les noms sont attachés entre eux il n'y a pas d'espace

**Krovax** · 14/05/2009, 16h49

J'ai pas suvit l'ensemble de ton code mais visqiblement tu tire les 9 nom dans la première partie et tu les stock dans w.
Il est normale que tant que tu ne met pas w a jour tu n'est pas près d'avoir de nouveau nom.
essaye peut etre ceci

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
 
Sub FIP_AIP_MUSC_3() 
 
Dim i As Byte, y() As Variant, z() As Variant, x As Integer, c As New Collection 
Dim p As Range, v As Byte, w(8) As String
 
For Each p In Sheets("Mois en cours").Range("F4:F34") 
Randomize 
y = Array(16, 17, 18) 
z = Array(9, 25, 42) 
For i = 0 To 2 
Do While c.Count < 3 
x = Int(y(i) * Rnd + z(i)) 
If Cells(x, 3) = 1 And Cells(x, 3).Interior.ColorIndex <> 3 Then 
On Error Resume Next 
c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address) 
If Err = 0 Then 
On Error GoTo 0 
w(v) = Cells(x, 2).Value 
v = v + 1 
End If 
On Error GoTo 0 
End If 
Loop 
Set c = Nothing 
Next i 
 
 
If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then 
p.Value=w(0)
for v=1 to 8 
p.Value =p.value & chr(10) &  w(v) 
next v
End If 
Next p 
 
 
End Sub

A chaque fois que l'on cha,nge de cellule on relance la première partie de ta macro qui visiblement s'occupe du tirage des noms

**mgrizzly** · 14/05/2009, 19h57

OK merci mais je me suis trompé, je voulais dire changer les noms à partir de la ligne 18, mon tableau commençant à la ligne 4 et finissant à la ligne 34.

**Krovax** · 15/05/2009, 08h41

essaye ceci, la sub nom génère la liste de 8 noms tu l'utilise comme tu le sent

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
 
Sub nom(w() As String)
Dim v As Byte
 
Randomize
y = Array(16, 17, 18)
z = Array(9, 25, 42)
For i = 0 To 2
Do While c.Count < 3
x = Int(y(i) * Rnd + z(i))
If Cells(x, 3) = 1 And Cells(x, 3).Interior.ColorIndex <> 3 Then
On Error Resume Next
c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address)
If Err = 0 Then
On Error GoTo 0
w(v) = Cells(x, 2).Value
v = v + 1
End If
On Error GoTo 0
End If
Loop
Set c = Nothing
Next i
 
End Sub
 
 
Sub test()
Dim p As Range, v As Byte, w(8) As String
 
nom w
 
For Each p In Sheets("Mois en cours").Range("F4:F18")
If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then
p.Value = w(0)
For v = 1 To 8
p.Value = p.Value & Chr(10) & w(v)
Next v
End If
Next p
 
 
nom w
 
For Each p In Sheets("Mois en cours").Range("F19:F34")
If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then
p.Value = w(0)
For v = 1 To 8
p.Value = p.Value & Chr(10) & w(v)
Next v
End If
Next p
 
End Sub

**mgrizzly** · 15/05/2009, 09h11

Merci beaucoup Krovax! Ca marche nikel

**mgrizzly** · 15/05/2009, 10h03

J'ai essayé de prendre 4 cellules au lieu de 3: j'ai mis

Code :

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

Do While c.Count < 4

mais ça me fait une erreur ici

Code :

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

w(v) = Cells(x, 2).Value

qui dit " l'indice n'appartient pas à la sélection".
Qu'est ce que je dois changer?

**Krovax** · 15/05/2009, 10h26

Oui car tu dépasse les dimension de w qui est un tableau de 9 ligne (de 0 à 9)
modifie

Code :

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

w(8) As String

en remplaçant le 8 par la bonne valeur (je te laisse trouver, j'aime pas du tout l'algo utilisé c'est a cents lieu de ma facon de fonctionner)

ensuite remplace

Code :

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