Random sur des noms

Version imprimable

22/04/2014, 09h11
yeti7984

1 pièce(s) jointe(s)

Random sur des noms

Bonjour

je vous explique le besoin ( en fin si c’est possible )

sur le fichier ci joint , il y a un onglet (feuil2) qui contient une liste de personne et sur l'autre onglet ( feuil1) un tableau .

je dois repartir les noms dans les 3 colonnes ( transport, maillot, permanence), pour qu'il y ai un roulement.

sachant qu'une personne qui transporte ne sera pas de maillot , celle qui est de maillot ne sera pas de permanence...etc

l'autre difficulté est qu'il faut faire en fonction des domicile extérieur , tout est expliqué dans le fichier ci joint.

je ne sais pas si cela est réalisable , je vous remercie d'avance pour votre aide.

voici le fichier de base :
Pièce jointe 143623

Bonjour yeti7984,

Voici un petit truc que je te propose :

Code:

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 random_effectif()
Dim lowerbound As Integer
Dim upperbound As Integer
Dim ori As Range
Dim rng As Range
Dim nom_index(1 To 3) As Integer
Dim test As Integer
 
With Worksheets("Feuil2")
    Set ori = .Range("A1")
    lowerbound = 4
    upperbound = .Columns(1).Find("*", , , , , xlPrevious).Row - 1
End With
 
With Worksheets("Feuil1")
    Set rng = .Range("B3")
    For i = 1 To .Columns(2).Find("*", , , , , xlPrevious).Row - 3
        If rng.Offset(i, 0) = "domicile" Then
            nom_index(1) = rand(lowerbound, upperbound)
            test = rand(lowerbound, upperbound)
            Do Until test <> nom_index(1)
                test = rand(lowerbound, upperbound)
            Loop
            nom_index(2) = test
 
            For j = 1 To 2
                rng.Offset(i, j + 1) = ori.Offset(nom_index(j) - 1, 0)
            Next j
        ElseIf rng.Offset(i, 0) = "extérieur" Then
            nom_index(1) = rand(lowerbound, upperbound)
            test = rand(lowerbound, upperbound)
            Do Until test <> nom_index(1)
                test = rand(lowerbound, upperbound)
            Loop
            nom_index(2) = test
 
            test = rand(lowerbound, upperbound)
            Do Until test <> nom_index(1) And test <> nom_index(2)
                test = rand(lowerbound, upperbound)
            Loop
            nom_index(3) = test
 
            rng.Offset(i, 1) = ori.Offset(nom_index(1) - 1, 0) & ", " & ori.Offset(nom_index(2) - 1, 0)
            rng.Offset(i, 2) = ori.Offset(nom_index(3) - 1, 0)
        End If
    Next i
End With
 
End Sub
 
Private Function rand(lowerbound As Integer, upperbound As Integer)
    Randomize
    rand = CInt((upperbound - lowerbound + 1) * Rnd()) + lowerbound
End Function

Ce n'est pas optimisé, mais je pense que ça répond à te demande - sous réserve d'avoir compris ton problème.
N'hésite pas à revenir vers moi si tu rencontres un problème.

Cordialement,
Kimy

C'était assez compliqué, mais voilà une proposition assez équitable au niveau du nombre de présence et non au niveau du nombre de postes attribués.

Adapter les plage dans la procédure REMPLIR et éventuellement la constante DOM

Code:

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
Option Explicit
 
Const DOM As String = "domicile"
 
'On va remplir Feuil1.Range("A4:E16") à partir de la liste des nom se trouvant en Feuil2.Range("A4:A15")
Sub REMPLIR()
 
Application.ScreenUpdating = False
DISPATCH Feuil2.Range("A4:A15"), Feuil1.Range("A4:E16")
End Sub
 
Private Sub DISPATCH(ByVal RngN As Range, ByVal RngP As Range)
Dim M As Long, N As Long, Nb As Long, i As Long, j As Long
Dim k As Integer, ColMax As Integer, ColIni As Integer
Dim Typ As String
Dim TbN, TbP
 
TbN = RngN.Value
TbP = RngP.Resize(RngP.Rows.Count + 1, RngP.Columns.Count + 1).Value
 
Typ = RngP.Offset(, 1).Resize(, 1).Address
Nb = Evaluate("3*COUNTA(" & Typ & ")-COUNTIF(" & Typ & ",""" & DOM & """)")
 
AleaTab TbN
N = UBound(TbN, 1)
j = 1
k = IIf(TbP(1, 2) = DOM, 5, 3)
 
For i = 1 To Nb
    M = IIf(i Mod N = 0, N, i Mod N)
    TbP(j, k) = UCase(TbN(M, 1))
    ColMax = IIf(TbP(j, 2) = DOM, 6, 5)
    k = k + 1
    If k > ColMax Then
        j = j + 1
        k = IIf(TbP(j, 2) = DOM, 5, 3)
    End If
Next i
 
For i = 1 To UBound(TbP, 1)
    If TbP(i, 3) <> "" Then TbP(i, 3) = TbP(i, 3) & " / " & TbP(i, 4)
    TbP(i, 4) = TbP(i, 5)
    TbP(i, 5) = TbP(i, 6)
Next i
RngP = TbP
End Sub
 
Private Sub AleaTab(ByRef Tbl)
Dim i As Long, j As Long, N As Long
Dim Tmp As String
 
N = UBound(Tbl, 1)
Randomize
For i = 1 To N
    j = CLng(((N - i) * Rnd) + i)
    If i <> j Then
        Tmp = Tbl(i, 1)
        Tbl(i, 1) = Tbl(j, 1)
        Tbl(j, 1) = Tmp
    End If
Next i
End Sub

25/04/2014, 15h58
yeti7984

merci les gars pour vos réponses , je regarde tout :P