XL 2013 remplir une liste aléatoirement et sans doublons

[kingfadhel]

Bonjour à tous,
Je viens encore une fois vers les XLDs, à la recherche d'une solution pour un petit problème.
- J'ai trois listes d'agents, chacune dans une colonne
- J'ai un nombre bien déterminé de poste ou je dois leurs affecter le personnel.
- Je dois affecter, aléatoirement et sans doublons, les matricules selon le nombre demandé dans la zone "F3:L3".

les agents de la liste A ne sont affecté que dans les colonnes F et G et le reste dans M
les agents de la liste B ne sont affecté que dans les colonnes H et I et le reste dans M
les agents de la liste C ne sont affecté que dans les colonnes J,K et L et le reste dans M

 

[Dranreb]

Bonjour.
Voyez si ça vous convient.

 

[sylvanu]

Bonjour Kingfadhel, dranreb,
Un essai en PJ.
Je pense qu'on peut optimiser avec de multiples arrays, mais je me suis attaché à bien vérifié la non répétition de matricule.

 

[kingfadhel]

Bonjour.
Voyez si ça vous convient.

c'est exactement ça.

 

[kingfadhel]

Bonjour Kingfadhel, dranreb,
Un essai en PJ.
Je pense qu'on peut optimiser avec de multiples arrays, mais je me suis attaché à bien vérifié la non répétition de matricule.

Aussi c'est fonctionnel.

 

[job75]

Bonsoir kingfadhel, bernard, sylvanu,

Une solution assez facile à comprendre dans le fichier joint :

Sub Tirages()
Dim a, d As Object, decal&, col%, ligmax&, n%, nn%, c As Range, im&, i&, lig&
a = Array([F3:G3,M3], [H3:I3,M3], [J3:L3,M3])
Set d = CreateObject("Scripting.Dictionary")
decal = 3 'les résultats sont décalés de 3 lignes
Randomize
Application.ScreenUpdating = False
For col = 1 To UBound(a) + 1 'numéro de la colonne source
    d.RemoveAll 'RAZ
    ligmax = Application.CountA(Columns(col)) 'il ne faut pas de cellules vides...
    n = 0
    nn = a(col - 1).Count
    For Each c In a(col - 1)
        n = n + 1
        If n < nn Or im = 0 Then c(decal + 1).Resize(Rows.Count - c.Row - decal + 1).ClearContents 'RAZ de la colonne
        For i = IIf(n = nn, im + 1, 1) To Val(c)
            If d.Count = ligmax - 1 Then Exit For
            Do
                lig = Application.RandBetween(2, ligmax) 'nombre entier aléatoire
            Loop While d.exists(lig)
            d(lig) = ""
            c(decal + i) = Cells(lig, col) 'restitution
            If n = nn Then im = i 'mémorise la ligne
Next i, c, col
End Sub

Nota : s'il y avait plusieurs milliers de valeurs en colonnes A B C il faudrait utiliser des tableaux VBA pour restituer les résultats, je ne le fais pas pour que ce soit plus compréhensible.

A+

 

[job75]

J'ai testé avec 3333 matricules dans chacune des colonnes A B C donc 9999 au total.

La macro s'exécute chez moi en 1 seconde, pas besoin de tableaux VBA.

Edit : la durée se décompose en :

- calculs => 0,75 à 0,9 seconde

- restitution dans la feuille => 0,25 seconde.

 

[kingfadhel]

Bonsoir @Dranreb , @sylvanu , @job75 et à tous,
Excellent job @job75

J'ai testé avec 3333 matricules dans chacune des colonnes A B C donc 9999 au total.

La macro s'exécute chez moi en 1 seconde, pas besoin de tableaux VBA.

Edit : la durée se décompose en :

- calculs => 0,75 à 0,9 seconde

- restitution dans la feuille => 0,25 seconde.