Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Répartition effectifs par postes et selon qualifications sans doublons

Jokerdu13

XLDnaute Nouveau
Bonjour à tous,

Je cherche depuis un bon moment (3 jours maintenant...) une formule mais rien n'y fait: je n'arrive pas à adapter ce que je trouve. J'espère que vous aurais quelques minutes pour me conseiller. Merci d'avance, c'est pour un événement associatif!

J'ai des Equipes de 4 personnes (Personnel 1,2,3 et 4) avec 3 qualifications différentes (Qualif 1,2 et 3) :
- Personnel 1 - Qualif 1
- Personnel 2 et 3 - Quafif 2
- Personnel 4 - Qualif 3

J'ai entre 17 et 24 Équipes selon les jours à répartir sur des postes ou il faut 1, 2 ou 3 équipes selon les besoins.

J'aimerai les répartir de manière aléatoire quant au positionnement, mais de manière à respecter la structure de l'équipe quant aux compétences.

La répartition, dans l'idéal, irait chercher les noms et prénoms dans un tableau et remplirai le tableau planning.

Est ce que quelqu'un a déjà pu faire des trucs de ce genre?

Merci beaucoup pour votre aide et/ou vos commentaires.
 
Dernière modification par un modérateur:

Jokerdu13

XLDnaute Nouveau
Re : Répartition effectifs par postes et selon qualifications sans doublons

Un paramètre qui pourrait être important:

Les noms des personnels sont amenés à varier selon les jours...

Merci encore pour votre aide!
 

Jokerdu13

XLDnaute Nouveau
Re : Répartition effectifs par postes et selon qualifications sans doublons

Bonjour,

Ci-joint un tableau type.

Merci de votre aide!
 

Pièces jointes

  • Tableau type pour répartition.xlsx
    42.8 KB · Affichages: 58
  • Tableau type pour répartition.xlsx
    42.8 KB · Affichages: 55

CBernardT

XLDnaute Barbatruc
Re : Répartition effectifs par postes et selon qualifications sans doublons

Bonjour Jokerdu13,

Après une rapide étude de la faisabilité de la répartition de l’effectif présent pour composer les 17 à 24 Équipes nécessaires selon les jours pour chaque période, il apparait, sauf erreur de ma part, que les effectifs présents annoncés pour chaque période sont très largement sous-estimés. Exemple pour la période 1, 17 personnels qualif 1 sont présents, 9 de qualif 2 et 9 de qualif 3. Cet effectif de 35 personnes limite le nombre d'équipes de 4 personnes à 8. On est très loin des 17 à 24 équipes annoncées. Peut-on avoir l’exemple de la planification d'une période afin de mieux comprendre le processus de planification à adopter et à automatiser.
 

Jokerdu13

XLDnaute Nouveau
Re : Répartition effectifs par postes et selon qualifications sans doublons

Bonjour,

Je vous remercie de vous intéresser à mon cas! C'est vraiment sympa

Effectivement il n'y a pas assez de monde en l'état pour remplir l'ensemble des équipes (d'autant que je me suis planter... Les équipes de 4 personnes varient de 3 à 25 équipes).

Toutefois, il s'agit d'un rassemblement associatif et le tableau est le reflet de la situation de réception des dispos des uns et des autres. C'est pour ça que j'espérais une solution "étirable" permettant, au fur et à mesure que les gens annoncent leur dispos: on les ajoutes à la suite dans la liste de leur qualification respective et la répartition comble les places restantes.

Suis-je clair? Vous pensez ça possible?

Rien que les conditions de dire que la qualif 1 peut remplacer la 2 et que la deux peux remplacer la 3 et je me perdais dans les formules...

Ci-joint un tableau avec, dans chaque période, les équipes barrés quand il n'y a pas d'activité pour elles pour avoir un aperçu du planning final espéré.

Encore un grand merci de vos efforts!

Bien à vous.
 

Pièces jointes

  • Tableau type pour répartition.xlsx
    42.6 KB · Affichages: 54
  • Tableau type pour répartition.xlsx
    42.6 KB · Affichages: 38

CBernardT

XLDnaute Barbatruc
Re : Répartition effectifs par postes et selon qualifications sans doublons

Bonjour,

Je pense qu'il serait bon d'effectuer un tableau de planification qui s'appuierait sur un calendrier roulant (Que l'on peut faire avancer dans le temps) et qui se limiterait à deux périodes successives.

A quoi correspondent les périodes d'activité ? 1 jour , 1 semaine, 1 mois...

Cela n'empêcherait pas de récupérer les disponibilités des personnes sur les périodes suivantes.

Un petit exemple joint.
 

Pièces jointes

  • PlanningHebdomadaire-Employés-V1.xlsm
    56.9 KB · Affichages: 86

KenDev

XLDnaute Impliqué
Re : Répartition effectifs par postes et selon qualifications sans doublons

Bonjour Joker, Bernard,

Une possibilité avec le code testé ci-joint adapté au fichier fourni. Une réserve: les données fournies permettent de ne constituer que 8,6,9,8,10,9,9,8 équipes pour les 8 périodes. Si dans le cas réel le nombre d'équipes était très supérieur il est possible qu'il faille revoir le typage de certaines variables.

Cordialement

KD

VB:
Const Sh1$ = "Qualif ", Sh2$ = "Planning Période ", fnR% = 3, fpC% = 2, Lg% = 6, Co% = 3, eLg% = 7, eCo% = 4
Dim Ta(), Tb%(), Tc%()
'fnR=1ere ligne des noms feuilles Sh1
'fpC=derniere colonne avant colonne période 1 des feuilles Sh2
'Lg/Co nb de lignes/colonnes par équipe
'eLg/eCo nb d'équipes par lignes/nb de lignes d'équipes
Sub Test()
    Dim a&, i&, b&, j&, d&, e%(), f%(), c&, g&, h As Boolean, w As Worksheet, k%, x%, y%, lig%, col%
    If ShNb(Sh1) <> 3 Then MsgBox "Nombre de feuilles " & Sh1 & "<> 3": Exit Sub
    a = ShNb(Sh2)
    If a = 0 Then MsgBox "Feuille " & Sh2 & "1 non trouvée": Exit Sub
    Randomize
    For i = 1 To a
        Call Menage(i): Call Inventaire(i): b = UBound(Ta, 2): ReDim Tb(1 To 3)
        For j = 1 To b: Tb(Ta(0, j)) = Tb(Ta(0, j)) + 1: Next j
        d = TeamMaxNb
        If d = 0 Then MsgBox "Aucune équipe posible pour la période " & i: GoTo Line1
        e = CbNthTab(Tb(1), d, Int(CombinNb(Tb(1), d) * Rnd) + 1): f = CbComp(e, Tb(1)): Erase e
        For j = 1 To UBound(f): Ta(0, f(j)) = 2: Next j
        Erase f
        Tb(2) = Tb(2) + Tb(1) - d: e = CbNthTab(Tb(2), 2 * d, Int(CombinNb(Tb(2), 2 * d) * Rnd) + 1): c = 0: g = 1
        For j = 1 To d + Tb(2)
            If Ta(0, j) = 2 Then
                c = c + 1
                If g > 2 * d Then
                    Ta(0, j) = 3
                ElseIf e(g) <> c Then
                    Ta(0, j) = 3
                Else
                    g = g + 1
                End If
            End If
        Next j
        Tb(3) = b - 3 * d: e = CbNthTab(Tb(3), d, Int(CombinNb(Tb(3), d) * Rnd) + 1): c = 0: g = 1
        For j = 1 To b
            If Ta(0, j) = 3 Then
                c = c + 1
                If g > d Then
                    Ta(0, j) = 0
                ElseIf e(g) <> c Then
                    Ta(0, j) = 0
                Else
                    g = g + 1
                End If
            End If
        Next j
        ReDim e(3): ReDim Tc(2, 1 To 2 * d)
        For j = 1 To b: e(Ta(0, j)) = e(Ta(0, j)) + 1: h = Ta(0, j) = 3: Tc(Ta(0, j) + 2 * h, -h * d + e(Ta(0, j))) = j: Next j
        Set w = Worksheets(Sh2 & i)
        For j = 1 To d
            x = Int(j / eLg): y = j Mod eLg: lig = x + 1 + (y = 0): col = y + -eLg * (y = 0): lig = (lig - 1) * Lg + 2: col = (col - 1) * Co + 2
            Do: e = CbNthTab(d, 1, Int(d * Rnd) + 1): Loop Until Tc(1, e(1)) > 0
            For k = 1 To 2: w.Cells(lig, col + k - 1) = Ta(k, Tc(1, e(1))): Next k
            Tc(1, e(1)) = 0
            Do: e = CbNthTab(2 * d, 2, Int(2 * d * (2 * d - 1) / 2 * Rnd) + 1): Loop Until Tc(2, e(1)) * Tc(2, e(2)) > 0
            For k = 1 To 2: w.Cells(lig + 1, col + k - 1) = Ta(k, Tc(2, e(1))): w.Cells(lig + 2, col + k - 1) = Ta(k, Tc(2, e(2))): Next k
            For k = 1 To 2: Tc(2, e(k)) = 0: Next k
            Do: e = CbNthTab(d, 1, Int(d * Rnd) + 1): Loop Until Tc(1, d + e(1)) > 0
            For k = 1 To 2: w.Cells(lig + 3, col + k - 1) = Ta(k, Tc(1, d + e(1))): Next k
            Tc(1, d + e(1)) = 0
        Next j
Line1:
    Next i
End Sub
Private Function TeamMaxNb() As Long
    Dim t&(), i&, j&, u&, a&, b&, k%
    ReDim t(1 To 3, 1 To 1)
    For i = 1 To 3: t(i, 1) = Tb(i): Next i
    ReDim Preserve t(1 To 3, 1 To Tb(1))
    For i = 2 To Tb(1): For j = 1 To 3: t(j, i) = t(j, i - 1) + (j = 1) - (j > 1) * (3 - j): Next j, i
    For i = 1 To Tb(1)
        u = UBound(t, 2): ReDim Preserve t(1 To 3, 1 To u + t(2, i) - 1)
        For j = 1 To 3: t(j, u + 1) = t(j, i) + (j > 1) - 2 * (j > 2): Next j
        For j = 3 To t(2, i): For k = 1 To 3: t(k, u + j - 1) = t(k, u + j - 2) + (k > 1) - 2 * (k > 2)
    Next k, j, i
    For i = 1 To UBound(t, 2)
        a = t(1, i): b = Int(t(2, i) / 2)
        If b < a Then a = b
        If t(3, i) < a Then a = t(3, i)
        If a > TeamMaxNb Then TeamMaxNb = a
    Next i
End Function
Private Sub Inventaire(ByVal Per%)
    Dim i%, w As Worksheet, c&, r&, j&, k%
    ReDim Ta(2, 0)
    For i = 1 To 3
        Set w = Worksheets(Sh1 & i): r = w.Cells(Rows.Count, 1).End(xlUp).Row
        If r < fnR Then ReDim Ta(0): Exit Sub
        For j = fnR To r
            If w.Cells(j, fpC + Per) = "X" Then
                c = c + 1: ReDim Preserve Ta(2, c): Ta(0, c) = i
                For k = 1 To 2: Ta(k, c) = w.Cells(j, k): Next k
            End If
    Next j, i
End Sub
Private Sub Menage(ByVal Sh&)
    Dim w As Worksheet, i%, j%
    Set w = Worksheets(Sh2 & Sh)
    For i = 1 To eCo: For j = 1 To eLg: w.Range(w.Cells((i - 1) * Lg + 2, (j - 1) * Co + 2), w.Cells(i * Lg - 1, j * Co)).ClearContents: Next j, i
End Sub
Private Function ShNb(ByVal Nm$) As Long
    Dim i&, w As Worksheet
    On Error GoTo LineEnd
    For i = 1 To Worksheets.Count: Set w = Worksheets(Nm & i): Next i
LineEnd:
    ShNb = i - 1
End Function
Private Function CbNthTab(ByVal a&, ByVal b&, ByVal n#) As Integer()
    Dim Tb&(), i&, x#, d&, Tf%()
    ReDim Tb(b)
    Do
        d = d + 1: x = 0
        For i = a - 1 - Tb(d - 1) To b - d Step -1
            x = x + CombinNb(i, b - d)
            If Not n > x Then Exit For
        Next i
        Tb(d) = a - i: n = n - x + CombinNb(i, b - d)
    Loop Until d = b
    ReDim Tf(1 To b)
    For i = 1 To b: Tf(i) = Tb(i): Next i
    CbNthTab = Tf
End Function
Private Function CombinNb(ByVal a%, ByVal b%) As Double
    Dim c%
    c = a - b
    If b < c Then c = b
    If c = 0 Then CombinNb = 1 Else CombinNb = MathFactoriel(a, c) / MathFactoriel(c)
End Function
Private Function MathFactoriel(ByVal Nb%, Optional Iter% = 0) As Double
    Dim i&, n&
    If Iter = 0 Then Iter = Nb
    MathFactoriel = 1
    For i = 0 To Iter - 1: MathFactoriel = MathFactoriel * (Nb - i): Next i
End Function
Private Function CbComp(Cb%(), a%) As Integer()
    Dim b&, c&, u&, Tb%(), i&, j&
    u = UBound(Cb): b = a - u: ReDim Tb(1 To b)
    For j = 1 To Cb(1) - 1: Tb(j) = j: Next j
    c = j - 1
    For i = 2 To UBound(Cb): For j = Cb(i - 1) + 1 To Cb(i) - 1: c = c + 1: Tb(c) = j: Next j, i
    For j = Cb(u) + 1 To a: Tb(c + j - Cb(u)) = j: Next j
    CbComp = Tb
End Function
 

Jokerdu13

XLDnaute Nouveau
Re : Répartition effectifs par postes et selon qualifications sans doublons

Bernard et KenDev vraiment merci pour ces pistes de solutions!

Bernard: Merci pour votre tableau! Je ne sais pas faire un bouton comme vous le faites, je me demande si je vais arriver à comprendre les formules! Il y a du VBA derrière?

Les périodes sont des tranches de 12H00 et il y a donc Lundi Jour, Lundi Nuit, etc... du Jeudi au Lundi matin. Je ne me suis pas poser la question de l'agenda puisque la répartition est simplement là pour organiser l’événement... Mais votre méthode est mieux puisque si l'an prochain on le fait sur une durée plus longue...

KenDev un grand merci! Effectivement ça marche! étant incapable de faire un bouton de triage... Heureusement que j'ai posé la question parce que je suis complètement incapable de produire ça!!! c'est un truc de fou! Merci!

Par contre lorsque vous parlez de faire évoluer les valeurs... Vue que la première fenêtre VBA que j'ai ouverte c'est.... aujourd'hui... est ce que ce sera une manipulation simple pour la suite (prenant en compte que je comprends pas grand chose à votre super travail, mais que je m'aperçois que ça marche bien!). Et l’incrémentation des nouveaux noms? Dois-je toucher quelque chose une fois que j'ai la liste définitive de personne?

Un grand merci à vous deux pour vos réponses!
 

KenDev

XLDnaute Impliqué
Re : Répartition effectifs par postes et selon qualifications sans doublons

Bonjour Joker,

Non il n'y a rien à modifier et la sub devrait fonctionner en rajoutant des noms (relancer la sub après les ajouts). Veuillez simplement à veiller à ce que les tableaux Qualifs restent biens entretenus (pas de nom vide en feuilles Qualifs colonne A par exemple).

La sub sera facilement adaptables pour quelques modifs de présentations mineurs. Ce sont les constantes de la toute première ligne du code que vous pouvez adapter en vous aidant des commentaires en vert dans code.

Cordialement

KD
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…