Remplir emploi du temps avec une table de correspondance

Bonjour le forum,

Je voudrais remplir les cases d'un emploi du temps avec un tirage aléatoire entre 1 et 28 :

image

de fàçon à remplir l'emploi du temps avec les matiéres concernées (durées en heures):

image

Ce qui me pose probléme pour le moment n'est pas le tirage mais le remplacement des chiffres par les matières. (code en module1)

Merci de votre aide.

10test.xlsm (18.26 Ko)

bonsoir,

il n'y a pas de module1, mais quelque chose dans la module de la feuil1.

La somme du tableau en "3" est 23,5.

Je ne comprends pas bien le truc aléatoire.

Bonjour Mister,

Finalement j'y suis arrivé, avec les doublons à droite à intégrer:

image

Mais tout reste à faire, avec les 13 autres classes et les mêmes emplois du temps des profs sans doublons.

Cdt

4test.xlsm (25.04 Ko)

bonjour,

Sub test2()
     Dim Arr

     a = Sheets("classes").Range("A1").CurrentRegion.Value     'lire ces données dans une matrice
     For i = 2 To UBound(a)     'boucle la matrice
          s = s & WorksheetFunction.Rept(a(i, 1) & "|", a(i, 2))     'dans s, ajouter autant fois la matière que indiqué dans colonne B avec un pipe "|" comme séparateur
     Next

     If s = "" Then Exit Sub
     sp = Split(Left(s, Len(s) - 1), "|")     'séparer ce string dans une nouvelle matrice
     Arr = sp     'copier dans une autre matrice pour pouvoir changer les dimensions
     Set c0 = Sheets("emplTps").Range("B3:F8")     'plage à remplir
     i = c0.Cells.Count - 2     'nombre de cellules a remplir sauf 2
     If UBound(Arr) < i - 1 Then ReDim Preserve Arr(i - 1)     'si nombre inférieur (à partir de 0, élément 0 est le premier, donc -1 !!!) ajouter autant de possibilités "vide"
     ptr = UBound(Arr)

     c0.ClearContents     'vider la plage
     For Each c In c0.Cells     'boucle les cellules
          Select Case c.Address
               Case "$D$7", "$D$8"     'heures non scolaires
               Case Else
                    r = WorksheetFunction.RandBetween(0, ptr)     'numéro aléatoire entre 0 et ce pointer
                    c.Value = Arr(r)     'cette leçon aléatoire
                    Arr(r) = Arr(ptr)     'important à comprendre, deplacer la derniere FREE lecon vers la position de la lecon choisi !!
                    ptr = ptr - 1     'decrementer le nombre de FREE leçons
          End Select
     Next

End Sub

Hello BsAlv,

Super le résultat sans doublon, mais ton code est trop balaise pour moi, j'ai trop de questions.

Tu déclares une seule variable

Je vais essayer de déchiffrer morceau par morceau, j'en ai pour un mois ou une semaine au mieux.

A+

Tu déclares une seule variable = c'est un choix personnel et conscient

vous avez 24 lecons possible, donc je crée un string avec 4 fois "Anglais", une fois "Composite", une fois "Conduit", ... séparé par un "|". Puis je coupe ce string en pièces sur ce "|". Comme vous avez besoin de 28 heures et il n'y a que 24 pièces ajoutez des heures vides jusqu'à 28 (on commence à compter avec 0, donc 27)

le truc aléatoir, supposons que vous avez ces 28 heures = 28 cartes dans un jeu de cartes (mais ils sont numérotés de 0 à 27).

premier tirage aléatoir entre 0-27 = par exemple 7 = copier le valeur de arr(7) vers la première cellule. Comme on ne peut plus utiliser cette carte, il y a un trou dans la matrice de 28 éléments (0-27), ce qui est ambetant . Le truc = copier la valeur du 27ième élément à la place 7 et diminue le nombre de choix à 26 = comme vous mettez la carte du bas au position de la carte tiré, la carte tiré, vous la jettez dans la poubelle, donc ils ne restent que 27 cartes à choisir

2ième tirage aléatoir est maintenant entre 0-26 (avec la valeur de 27ieme comme doublon à la position 7) = par exemple 3 = copier arr(3) à la 2ieme cellule et copier l'élément 26 à la position 3 et diminuer le nombre de choix à 25.

etc

Rechercher des sujets similaires à "remplir emploi temps table correspondance"