Ordre de passage, automatisé

Bonjour,

Je dois organiser un concours pour lequel j'attends à peu près 200 candidats.

Chaque candidat va me donner ses indisponibilités sur une semaine complète ou 2 en fonction de l'affluence.

Une fois ma base de donnée remplie avec les indisponibilités, je voudrais une macro capable d'établir un ordre de passage par jour en tenant compte des indisponibilités.

Pouvez vous m'aider

Merci

Tristan

Salut Tristan,

Premier jet, sur ma première idée, sans trop de fioritures.
- tu inscris en [B1] le nombre de candidats à placer par jour (ou tu acceptes le nombre calculé par une macro déclenché lors de l'ajout d'un candidat à ta liste ;
- tu double-cliques sur [B1] pour le calcul de placement avec résultats en feuille 'RDV' ;
- les "X" s'inscrivent ou s'effacent au clic

Public Sub RDV()
'
Dim tTab, tBDD
'
Application.ScreenUpdating = False
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
iCol = Cells(2, Columns.Count).End(xlToLeft).Column
tTab = Range("A3").Resize(iRow - 2, iCol + 1).Value
'
For x = 3 To iRow
    For y = 3 To iCol
        If IsDate(Cells(2, y)) Then Cells(x, y) = IIf(Cells(x, y) = "", "X", "")
    Next
    Cells(x, iCol + 1) = WorksheetFunction.CountIf(Range(fctCol(3) & x & ":" & fctCol(iCol) & x), "X")
Next
With Worksheets("RDV")
    .Cells.Delete
    Range("A2").Resize(1, iCol).Copy Destination:=.[A2]
    For x = 3 To iCol
        iNb = 0
        If Cells(2, x) <> "" Then
            Range("A3:" & fctCol(iCol + 1) & iRow).Sort key1:=Range(fctCol(iCol + 1) & 3), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlNo
            For y = 3 To iRow
                If Cells(y, 1) <> "" And Cells(y, x) <> "" Then _
                    iNb = iNb + 1: _
                    .Cells(2 + iNb, x) = Cells(y, 1): _
                    Cells(y, 1) = "": _
                    Cells(y, iCol + 1) = Cells(y, iCol + 1) - 1: _
                    If iNb = [B1] Then Exit For
            Next
        End If
    Next
    .Activate
End With
Range("A3").Resize(iRow - 2, iCol + 1).Value = tTab
'
Application.ScreenUpdating = True
'
End Sub

A+

Salut Tristan,

version corrigée de ses défauts de jeunesse.
- le calcul du nombre de placements par jour est maintenant correct ;
- un tri Key2 est ajouté, histoire de forcer le placement d'un candidat, même si le nombre max de placements est déjà atteint, si d'aventure, ce(s) dernier(s) candidat(s) n'avai(en)t pas d'autre possibilité.

A+