[VBA Excel] Tirage de personne en aleatoire selon 2 conditions

Tirage de personne en aleatoire selon 2 conditions [VBA Excel] - VB/VBA/VBS - Programmation

Marsh Posté le 29-11-2017 à 18:56:54    

Bonjour
 
Pour les besoins d'un generateur de planning, je cherche a faire une macro qui va selectionner 2 personnes
chaque personne a 2 critères, competence et presence
on doit avec un couple a chaque fois sur la présence, et le niveau doit pas etre inferieur a 2 (les niveau c'est juste 1 et 2)
pour l'instant on a 12 personnes, et en principe, ca changera pas
 
J'ai un tableau avec mes personnes, leur présence et leur niveau dans une feuille, que je stock dans 2 variables tableaux (selon leur presence)
 
Pour l'instant j'arrive a generer mes couples sans trop de soucis, mais une fois les 6/8 premier couple en place, je commence a tomber dans une boucle infinie a cause de mon random
en fait, j'aimerais que une fois un couple est tiré, que je puisse les supprimer de mes tableaux en variable, mais je sais pas faire, une idée ?
 
 
Voici mon code pour l'instant

Code :
  1. Function aleat(max)
  2. Randomize
  3. aleat = Int(max * Rnd)
  4. End Function
  6. Sub Tirage()
  8. Dim People_Int(5, 2)
  9. Dim People_Pre(5, 2)
  11. 'Declaration des 2 tableaux People
  12. ' Tableau interne
  13. Worksheets("Param" ).Activate
  14. Range("B4" ).Select
  15. i = 0
  16. While (ActiveCell.Value <> "" )
  17.     People_Int(i, 0) = i
  18.     People_Int(i, 1) = ActiveCell.Value
  19.     People_Int(i, 2) = ActiveCell.Offset(0, 1).Value
  20.     i = i + 1
  21.     ActiveCell.Offset(1, 0).Select
  22. Wend
  23. ' Tableau Presta
  24. Range("E4" ).Select
  25. j = 0
  26. While (ActiveCell.Value <> "" )
  27.     People_Pre(j, 0) = i
  28.     People_Pre(j, 1) = ActiveCell.Value
  29.     People_Pre(j, 2) = ActiveCell.Offset(0, 1).Value
  30.     j = j + 1
  31.     ActiveCell.Offset(1, 0).Select
  32. Wend
  34. 'on se remet sur la feuille de planning
  35. Worksheets("Planning" ).Activate
  36. 'on supprime les champs si deja mis
  37. Range("C4:N4" ).Value = ""
  38. Range("C4" ).Select
  40. 'Calcul des binomes Int Presta
  42. pmax = 0
  43. While (pmax < 12)
  45. resul = 1
  46. While (resul <> 0)
  47.     'Test du niveau selon le tirage
  48.     niv_int = 0
  49.     niv_pre = 0
  50.     While (niv_int + niv_pre < 2)
  51.         tir_int = aleat(max_int)
  52.         niv_int = People_Int(tir_int, 2)
  53.         tir_pre = aleat(max_pre)
  54.         niv_pre = People_Int(tir_pre, 2)
  55.     Wend
  56.     'Test si deja sorti ou pas
  57.     For Each cell In Range("C4:N4" )
  58.         If (cell = People_Int(tir_int, 1) Or cell = People_Pre(tir_pre, 1)) Then
  59.             resul = 1
  60.             Exit For
  61.         Else
  62.             resul = 0
  63.         End If
  64.     Next cell
  65. Wend
  67. 'si tout est OK, on met les nom
  68. ActiveCell.Value = People_Int(tir_int, 1)
  69. ActiveCell.Offset(0, 1).Value = People_Pre(tir_pre, 1)
  70. ActiveCell.Offset(0, 2).Select
  72. pmax = pmax + 2
  73. Wend
  74. End Sub


---------------
Serveur HFR - OpenTTD
Reply

Marsh Posté le 29-11-2017 à 18:56:54   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed