XL 2021 Panning de 8 conseillers en insertion pour visites a domicile sur 4 secteurs en binome

[annel78000]

Bonjour,

Je suis chargée de gestion locative et je peine à trouver une solution à mon problème.
Je suis sûre qu'il doit y avoir une formule adaptée que je ne connais pas.
J'ai 8 personnes qui doivent être en binômes chaque mois sur un secteur.
Je voudrais que les binômes changent tous les mois et de secteur afin que ce soit équilibré.

Au secours !

Merci pour votre retour.

 

[Dranreb]

Bonjour.
Sous réserve qu'après 4 manches/mois tout peut être rebattu, avec répétition éventuelle d'un secteur ou d'un binôme du dernier mois précédent, ça s'apparente au tirage de "Postes à 2" pour 8 joueurs et 4 postes, non ?

 

[annel78000]

Bonjour,

tout d'abord merci d'avoir repondu mais je suis vraiment desole mais j'azi rien compris.
je n'aie qu'un BEP compta!
je voudrai que les 8 salarié changent de binome tout les mois et changent de secteur tout les mois.
merci pour votre aide

 

[Dranreb]

Faites des essai sur la feuille de démo "Poste à 2" en saisissant 8 devant joueurs et 4 devant postes, puis en cliquant sur l'image d'une roue de loterie.
Notez qu'en l'état, cet algorithme n'empêcherait pas ces répétitions de binômes et de secteurs à chaque limite de groupes de 4 mois puisqu'après 4 mois tous les secteurs seraient de toute façon à revisiter par les mêmes personnes et après 7 mois tous les binôme devraient se reformer, généralement différemment mais pas forcément.

 

[annel78000]

merci beaucoup pour votre aide je vais essayer de suite.

 

[klin89]

Bonsoir à tous,

Pour assurer une répartition équitable, tu peux créer des carrés latins comme sur l'image ci-dessous.
Carré d'ordre 8 dans l'exemple.

klin89

 

[annel78000]

Faites des essai sur la feuille de démo "Poste à 2" en saisissant 8 devant joueurs et 4 devant postes, puis en cliquant sur l'image d'une roue de loterie.
Notez qu'en l'état, cet algorithme n'empêcherait pas ces répétitions de binômes et de secteurs à chaque limite de groupes de 4 mois puisqu'après 4 mois tous les secteurs seraient de toute façon à revisiter par les mêmes personnes et après 7 mois tous les binôme devraient se reformer, généralement différemment mais pas forcément.

Bonjour,

apres plusieurs tentative ca ne fonctionne pas.
en cliquant sur la roue ca ne se met pas a jour.

merci quand meme

 

[Dranreb]

Avez vous débloqué les macros ?

 

[klin89]

Re le forum,

.

A l'aide de cette macro trouvée sur le net, tu peux générer un carré latin d'ordre 8 aléatoirement.
Voir l'image ci-dessus.

Sub square()
    Const n& = 8
    Dim a, b, c(), arr
    Dim i, u, v, w, x, j

    ' Tableau associant les nombres aux prénoms
    arr = Array("Laure", "Sophie", "Claude", "Michel", "Zoe", "Xavier", "Max", "Clara")
   
    ' Initialisation des tableaux
    ReDim c(1 To n, 1 To n)
    a = Evaluate("row(1:" & n & ")"): b = a

    ' Mélange aléatoire des rangées et des colonnes
    Randomize
    For i = 1 To n
        u = Int(Rnd * (n - i + 1)) + i
        v = Int(Rnd * (n - i + 1)) + i
        w = a(i, 1): a(i, 1) = a(u, 1): a(u, 1) = w
        w = b(i, 1): b(i, 1) = b(v, 1): b(v, 1) = w
    Next i

    ' Construction du carré latin
    For j = 1 To n
        For i = 1 To n
            x = a(i, 1) + j - 1
            If x > n Then x = x - n
            ' Remplacement du numéro par le prénom correspondant
            c(i, a(j, 1)) = arr(b(x, 1) - 1) ' Utilisation de b(x, 1) pour indexer arr
        Next i
    Next j

    ' Affichage du carré latin dans la feuille Excel
    Range("B2").Resize(n, n).Value = c
End Sub

klin89

 

[klin89]

Re à tous,

Aprés tu peux générer plusieurs carrés latins si ça t'enchante

Sub MultiSquareWithNames()
    Const n& = 8 ' Taille du carré latin (8x8)
    Dim a, b, c()
    Dim i, u, v, w, x, j, k As Long
    Dim startRow As Long
    Dim arr As Variant
    
    ' Tableau des prénoms correspondant aux nombres 1 à 8
    arr = Array("Laure", "Sophie", "Claude", "Michel", "Zoe", "Xavier", "Max", "Clara")
    ReDim c(1 To n, 1 To n) ' initialisation de la matrice c
    ' Boucle principale pour générer 5 carrés latins
    For k = 0 To 4
        startRow = 2 + k * (n + 2) ' Position de départ pour chaque carré latin
                                   ' Espacement de 2 lignes
        a = Evaluate("row(1:" & n & ")"): b = a ' Initialisation des lignes et colonnes

        ' Mélange aléatoire des lignes et colonnes
        Randomize
        For i = 1 To n
            u = Int(Rnd * (n - i + 1)) + i
            v = Int(Rnd * (n - i + 1)) + i
            w = a(i, 1): a(i, 1) = a(u, 1): a(u, 1) = w
            w = b(i, 1): b(i, 1) = b(v, 1): b(v, 1) = w
        Next i

        ' Construction du carré latin avec des prénoms
        For j = 1 To n
            For i = 1 To n
                x = a(i, 1) + j - 1
                If x > n Then x = x - n
                ' Remplacement du numéro par le prénom correspondant dans le tableau arr
                c(i, a(j, 1)) = arr(b(x, 1) - 1)
            Next i
        Next j

        ' Affichage du carré latin dans la feuille Excel
        Range("B" & startRow).Resize(n, n).Value = c
    Next k
End Sub

klin89

 

[halecs93]

Une autre version du code qui consiste à utiliser tous les noms listés en colonne A. De là il génère un carré latin correspondant au nombre de noms.

Sub GenerateSquareLatin()
    Dim ws As Worksheet
    Dim n As Long
    Dim a, b, c()
    Dim names As Variant
    Dim i, u, v, w, x, j As Long

    ' Référence à la feuille 1
    Set ws = ThisWorkbook.Sheets("Feuil1")
    
    ' Lecture de la liste des noms dans la colonne A
    names = Application.Transpose(ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Value)
    
    ' Nombre de noms trouvés
    n = UBound(names) - LBound(names) + 1
    If n < 2 Then
        MsgBox "Il faut au moins 2 noms dans la colonne A pour générer un carré latin.", vbExclamation
        Exit Sub
    End If

    ' Initialisation des tableaux
    ReDim c(1 To n, 1 To n)
    a = Evaluate("row(1:" & n & ")"): b = a

    ' Mélange aléatoire des rangées et des colonnes
    Randomize
    For i = 1 To n
        u = Int(Rnd * (n - i + 1)) + i
        v = Int(Rnd * (n - i + 1)) + i
        w = a(i, 1): a(i, 1) = a(u, 1): a(u, 1) = w
        w = b(i, 1): b(i, 1) = b(v, 1): b(v, 1) = w
    Next i

    ' Construction du carré latin
    For j = 1 To n
        For i = 1 To n
            x = a(i, 1) + j - 1
            If x > n Then x = x - n
            ' Attribution des noms dans la grille
            c(i, a(j, 1)) = names(b(x, 1))
        Next i
    Next j

    ' Affichage du carré latin dans la feuille à partir de C1
    ws.Range("C1").Resize(n, n).Value = c

    ' Message de confirmation
    MsgBox "Carré latin généré avec succès à partir de la liste dans la colonne A.", vbInformation
End Sub

 

[klin89]

Re à tous,

annel78000, je suis parvenu à réaliser manuellement un carré latin réduit pour répondre à ta demande.
Soit ressortir toutes les combinaisons de 2 parmi 8 (28) pour les répartir dans chaque secteur sur une période de 4 mois avec les contraintes exposées.
J'en ai réparti que 16 sur 28 soit sur 4 lignes.
On ne peut pas répartir les 28 binômes sur 7 lignes (7 X 4) selon tes contraintes.
Voir la remarque de Dranreb au post #4

Dans l'image ci-dessous, on voit bien que des binômes différents changent tous les mois de secteurs.

A travers un tableau de correspondance et la fonction Alea(), tu pourras changer les binômes et en conséquence leur répartition.

Voir l'image ci-dessous :

Ci-joint le fichier
klin89