Code affiche erreur

bonjour

qui peut m'aider de corriger ce code (rectification d'erreur)

Bonjour, difficile de trouver avec une image.

Le code précédent c'est quoi ? une autre Public Sub ?

liste aliatoire

bonjour a tous

si possible un autre code aléatoire pour répartition de 70 profs sur 24 classes d'examens pour cinq jours (matin et soir)

Merci d’avance

bonsoir,

excel2016 ou excel2021-365 ?

bonjour a tous

si possible un autre code aléatoire pour répartition de 70 profs sur 24 classes d'examens pour cinq jours (matin et soir)

Merci d’avance

excel 2016

Merci beaucoup

toujours le mm probleme

c'est l'autre macro "aleatoire"

"bonjour a tous, si possible un autre code aléatoire pour répartition de 70 profs sur 24 classes d'examens pour cinq jours (matin et soir), Merci d’avance"

le macro "aleatoire" dans module1 est l'autre code aléatoire, que vous avez demandé. Je n'ai pas regardé a votre code pour cet erreur, parce que je ne sais pas ou commencer. C'est où? Mon macro vous donne une réponse après 0.2 seconde, donc peut-etre vous n'apercevez pas cela. L'algoritme fait son mieux pour que tous les professeurs ont le même nombre d'interventions "Remplaçant".

La seule chose à faire, c'est parametriser ce macro, de manière qu'il fonctionne autonome avec X professeurs, Y classes et Z périodes d'examens

Merci

mon dieu la même problème

Bonjour, le problème restera le même si vous ne changez pas le code de votre bouton de lancement.

Puisque le nouveau code de Bsalv que je salue au passage est dans le module 1 est s'appel aleatoire

votre bouton de lancement doit faire un "Call aléatoire". et vous supprimez toutes les autres lignes. (lignes vertes)

Private Sub CBnTirage_Click()
Call aleatoire
    ' Dim TNoms(), TRésu(), M As Long, L As Long, J As Long, C As Long
  '   TNoms = [TbProfs[Liste des profs]].Value
  '   If UBound(TNoms, 1) Mod 5 > 0 Then MsgBox "Le nombre de profsseurs doit être un multiple de 5", vbCritical, "Tirage": End
  '   If TiragePSimOK(NbJrs:=UBound(TNoms, 1), RClubs:=[TbProfs[Etablissment]]) Then
      '    ReDim TRésu(1 To UBound(Tirage, 2), 1 To 15)
        '  For L = 1 To UBound(Tirage, 2)
            '   C = 0
            '   For M = 1 To 5: For J = 1 To 3
                     '    C = C + 1
                    '     TRésu(L, C) = TNoms(Tirage(M, L, J), 1)
                  '  Next J, M, L
                  '  With Me.ListObjects(1).DataBodyRange
                      '   L = .Rows.Count - UBound(TRésu, 1)
                       '  Select Case Sgn(L)
                             ' Case 1: .Rows(2).Resize(L).Delete xlShiftUp
                            '  Case -1: .Rows(2).Resize(-L).Insert xlShiftDown
                      '   End Select
                '         .Columns(2).Resize(, 15).Value = TRésu: End With
             '  End If
          End Sub

Merci

si possible de le remplacer?

OK ca marche très bien pas débogage

mais je ne sais pas encore si fonctionne ou non

bien

le code fonctionne très bien , mais le bouton ne fonctionne pas

resultat :

- chaque professeur est 8 ou 9 fois sélectionné comme surveillant ou remplacant (donc assez equilibre)

- chaque professeur est 6 à 8 fois sélectionné comme surveillant

- chaque professeur est 0 à 3 fois sélectionné comme remplaçant

Sub BSALV_aleatoire()
     Dim iC, Plann, iProf, iSalle, iPériodes, c0, c, c2

     iSalle = 24     'nombre de salles
     iPériodes = 10     'nombre de périodes d'examen, par exemple 5 jours * 2 examen/jour

     T = Timer     'demarre le chronomètre
     Application.ScreenUpdating = False
     Set dict = CreateObject("scripting.dictionary")
     Randomize

     ReDim Plann(1 To iSalle, 1 To iPériodes * 3)     'array du planning

     Set c = Sheets("liste des profs").ListObjects("TBProfs").DataBodyRange     'les données des professeurs
     iC = c.Columns.Count     'nombre de colonnes
     a = c.Resize(, iC + 4).Value     'ajouter 4 colonnes comme brouillon
     iProf = UBound(a)     'nombre de professeurs

     For i = 1 To UBound(a)
          For J = 1 To 3: a(i, iC + J) = 0: Next     'les 3 premières colonnes de brouillon = 0
          a(i, iC + 4) = Rnd     '4ièem colonne de brouillon = aleatoire 0-1
     Next

     Set c0 = Sheets("result").Range("AA1")     'partie dans cette feuille qui sert à sorter
     c0.Resize(1000, 20).ClearContents
     Set c = c0.Resize(UBound(a), UBound(a, 2))

     For ipick = 1 To iPériodes     'boucle les périodes d'examen
          Randomize
          c.Value = a     'l'array a vers plage de brouillon

          With c.Parent.Sort     'sortkey =  nombre de fois selectionné (A) + nombre de fois surveillant (A) + nombre de fois remplacant (D) + aleatoire (A)
               .SortFields.Clear
               .SortFields.Add2 Key:=c.Columns(iC + 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c.Columns(iC + 2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c.Columns(iC + 3), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c.Columns(iC + 4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SetRange c
               .Header = xlNo
               .MatchCase = False
               .Orientation = xlTopToBottom
               .SortMethod = xlPinYin
               .Apply
          End With

          Set c2 = c.Offset(2 * iSalle)     'les 2*iSalle sont les surveillant, le rest maintenant, donc à partir du 2*isalle+1 ième professeur

          With c2.Parent.Sort     'sortkey =  nombre de fois selectionné (A) + nombre de fois remplacant (A) + aleatoire (A)
               .SortFields.Clear
               .SortFields.Add2 Key:=c2.Columns(iC + 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c2.Columns(iC + 3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c2.Columns(iC + 4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SetRange c2
               .Header = xlNo
               .MatchCase = False
               .Orientation = xlTopToBottom
               .SortMethod = xlPinYin
               .Apply
          End With

          arr = c.Value     'read to array

          For i = 1 To Application.Min(WorksheetFunction.Ceiling_Math(2.5 * iSalle, 1), iProf)     'nombre de personnes à assigner pour un examen
               ptr = arr(i, 1)     'pointer vers l'array a
               prof = arr(i, 2)     'nom du professeur
               Select Case i
                    Case 1 To iSalle: dict.Add dict.Count, Array(ipick, i, "Surv.1", prof, 1): Plann(i, (ipick - 1) * 3 + 1) = prof: a(ptr, iC + 2) = a(ptr, iC + 2) + 1     'surveillant 1
                    Case iSalle + 1 To iSalle * 2: dict.Add dict.Count, Array(ipick, i - 24, "Surv.2", prof, 1): Plann(i - 24, (ipick - 1) * 3 + 2) = prof: a(ptr, iC + 2) = a(ptr, iC + 2) + 1   'surveuillance2
                    Case Is > iSalle * 2: dict.Add dict.Count, Array(ipick, (i - 50) * 2 + 1, "Rempl.", prof, 0): Plann((i - 49) * 2 + 1, (ipick - 1) * 3 + 3) = prof: a(ptr, iC + 3) = a(ptr, iC + 3) + 1     'remplacant
               End Select
               a(ptr, iC + 1) = a(ptr, iC + 1) + 1
               a(ptr, iC + 4) = Rnd
          Next
     Next

     arr = Application.Index(dict.items, 0, 0)
     With Sheets("result").Range("A1").ListObject
          If .ListRows.Count Then .DataBodyRange.Delete
          If dict.Count Then
               .ListRows.Add.Range.Range("A1").Resize(UBound(arr), UBound(arr, 2)).Value = arr
          End If
     End With

     With Sheets("répartition").Range("B4")
          .Resize(100, 100).ClearContents
          .Resize(UBound(Plann), UBound(Plann, 2)).Value = Plann
     End With
     ThisWorkbook.RefreshAll

     MsgBox Timer - T
End Sub