Random toewijzen van spelers o.b.v. geslacht en functie

[Mari138]

Hallo allemaal.

Ik ben op zoek naar een oplossing waarbij ik zelf niet weet waar ik moet beginnen.
Een gehele oplossing zou super zijn, maar met een goede denkrichting ben ik misschien al geholpen.

Ik heb een fictief voorbeeld uitgewerkt in de bijlage.

- Het doel is om spelers automatisch in te delen in kolom E op basis van functie en geslacht.
- Functie en geslacht zijn gekoppeld aan het Plaatsnr. Zie kolom B+C+D.
Vb. Op basis van de vaste gegevens uit kolom B+C+D kan een man nooit keeper zijn en een vrouw nooit linksback.
- De spelerslijst in kolom H t/m L kan per dag verschillen.
- Nu komt naar mijn idee het lastige: het toewijzen van de namen aan de plaatsnummers moet random gebeuren o.b.v. geslacht en functie.
Vb. Een vrouwelijke middenvelder komt op 1-1-2016 te staan op plaatsnr 8, op 2-1-2016 op plaatsnr ? (als het maar op een plaats is met functie middenvelder en geslacht vrouw.
- Indien er te weinig spelers zijn worden de overige velden in de kolom E gevuld met een foutmelding.
- Indien er te veel spelers zijn worden de overblijvende spelers niet toebedeeld. (deze kan eventueel ook opgelost worden met het vooraf selecteren van precies genoeg speler).

Ik hoop dat mijn vraag duidelijk is, mocht dat niet het geval zijn dan hoor ik dat graag!

Alvast bedankt voor het meedenken! :thumb:

 

[Timshel]

Ik kom hierop uit:

Option Explicit

Sub tsh()
    Dim Br, Bq, Bt
    Dim i As Long
    Dim x As Long
    
    Randomize
    Br = Cells(1, 8).CurrentRegion
    With CreateObject("System.Collections.Arraylist")
        For i = 2 To UBound(Br)
            .Add Br(i, 3) & "|" & Br(i, 4) & "|" & Br(i, 5)
        Next
        Br = .ToArray
    End With
    Bq = Cells(1).CurrentRegion
    For i = 2 To UBound(Bq)
        Bt = Filter(Br, Bq(i, 4) & "|" & Bq(i, 3))
        If UBound(Bt) >= 0 Then
            x = Int(Rnd * (UBound(Bt) + 1))
            Bq(i, 5) = Split(Bt(x), "|")(0)
            Br = Filter(Br, Bt(x), False)
        Else
            Bq(i, 5) = [NA()]
        End If
    Next
    Cells(1).CurrentRegion = Bq
End Sub

 

[Mari138]

Ah dit is geweldig! Voor zover ik nu kan zien voldoet deze code helemaal.
Ik ga morgen direct kijken of ik hem nu helemaal kan toepassen op het praktijk voorbeeld.
Is het eenvoudig aan te geven hoe ik de brondata (kolom H t/m L) naar een ander tabblad kan verplaatsen?
Ik ben nog niet geheel thuis in VBA helaas. En in de code van VBA wordt zo te zien geen directe verwijzing naar kolommen/rijen gemaakt.

Nogmaals bedankt!

 

[Wigi]

En in de code van VBA wordt zo te zien geen directe verwijzing naar kolommen/rijen gemaakt.

Indirect wel:

Br = Cells(1, 8).CurrentRegion

De CurrentRegion is een aangesloten bereik van cellen tot er een lege kolom en rij rondom het hele bereik zit.
Sneltoets: Ctrl-*

 

[Timshel]

Zoals Wigi al zegt bepaalt de code zelf het gegevensbereik. De kolommenindeling is echter vastgelegd; als je die indeling verandert zou de code ook aangepast moeten worden.
Ik heb je voorbeeld aangepast naar meerdere werkbladen.

 

[Mari138]

Ik ben op basis van de vorige oplossing aan de slag gegaan maar loop tegen het probleem aan:
1 speler kan meerdere functies vervullen.

Ik heb de sheet aangepast en opnieuw geüpload, hopelijk kan iemand met vertellen hoe de code nu aangepast moet worden:
Tabblad Veldplaatsen - Kolom F moet het resultaat zijn van de code
Tabblad Spelers vandaag - Hier komen alle spelers welke vandaag spelen - vanuit de brondata wordt opgehaald op welke functie men kan spelen (1=kan spelen op deze functie/0=kan niet spelen op deze functie)
Tabblad Spelers brondata - Hier komen alle spelers welke vandaag spelen of in het verleden gespeeld hebben (1=kan spelen op deze functie/0=kan niet spelen op deze functie)
Als iemand een bijvoorbeeld op een nieuwe functie kan spelen wordt dit tabblad handmatig aangepast.
Tabblad Team 1 - nvt
Tabblad Team 2 - nvt
Tabblad Team 3 - nvt
Tabblad Team 4 - nvt

De spelregels van de file moeten zijn:
- Het doel is om spelers automatisch en random in te delen in kolom F op basis van de kolom D functie. (Geslacht is niet meer van belang! Immers moet nu op persoon worden aangegeven wat iemand kan qua functie)
- In de kolommen E t/m X op Tabblad Spelers vandaag en Spelers brondata betekend een 1 dat men die functie kan uitvoeren en een 0 dat ze dit niet kunnen.
- De spelerslijst in Tabblad Spelers vandaag kan dus dagelijks wijzigen. Nieuwe spelers moet ik eerst handmatig toevoegen aan tabblad Spelers brondata, daar staat in wat ze kunnen.
- Als ik 2 'Spits' en 2 'Keeper' functies beschikbaar heb en ik heb 4 spelers welke allemaal 'Keeper' kunnen zijn maar 2 van hen kunnen 'Spits' zijn dan moet hij eerst de 'Spits' plaatsen invullen, anders krijg ik lege plaatsen.
- Indien er te weinig spelers zijn worden de overige velden in de kolom E gevuld met een foutmelding.
- Indien er te veel spelers zijn worden de overblijvende spelers niet toebedeeld. (deze kan eventueel ook opgelost worden met het vooraf selecteren van precies genoeg speler).
- Tabblad veldplaatsen moet uitgebreid of verkort kunnen worden zonder dat de functionaliteit van het random indelen hierdoor te niet word gedaan.

Ik hoop dat de uitbreiding niet voor te veel problemen zorgt in de oplossing.
Alvast bedankt voor de hulp!

 

[Timshel]

...dan kom ik op een iets complexere code uit.
Even een stukje kansrekening; dat spelers toevalsgewijs worden ingedeeld betekent niet dat dat ook eerlijk gaat. Statistisch gezien zal het soms voorkomen dat dezelfde speler meerdere keren achter elkaar op de bank komt terwijl een andere speler telkens opgesteld wordt. Vergelijk het met een loterij waarbij het lijkt alsof telkens dezelfde deelnemer wint. Ook is het zo dat een speler meer kans maakt te worden opgesteld naarmate hij of zij over meer competenties beschikt. Mevrouw Zimmerman uit jouw voorbeeld kan alleen maar coachen. 400 anderen kunnen dat ook en als er maar 4 coaches per keer nodig zijn kan zij lang wachten.
Zet alle filters uit voor je de macro draait.

Option Explicit

Sub tsh()
    Dim Bq, Br, Bs, Bt
    Dim i As Long, j As Long
    Dim sPl As String
    
    Randomize
    Application.ScreenUpdating = False
    Br = Sheets("Spelers vandaag").Cells(1).CurrentRegion
    ReDim Bq(UBound(Br, 2) - 5)
    With CreateObject("System.Collections.Arraylist")
        For i = 2 To UBound(Br)
            For j = 5 To UBound(Br, 2)
                If Br(i, j) = 1 Then
                    .Add Br(i, 2) & "_" & Br(i, 3) & "_" & Br(i, 4) & "|" & Br(1, j)
                    Bq(j - 5) = Format(Val(Left(Bq(j - 5), 5)) + 1, "00000") & "_" & Br(1, j)
                End If
            Next
        Next
        Br = .ToArray
        .Clear
        For i = 0 To UBound(Bq)
            If Bq(i) <> "" Then .Add Bq(i)
        Next
        .Sort
        Bq = .ToArray
    End With
    
    With Sheets("Veldplaatsen")
        .Range("E2:F" & .Cells(Rows.Count, 4).End(xlUp).Row) = [NA()]
        Bs = .Cells(1).CurrentRegion
        For i = 0 To UBound(Bq)
            Bt = Filter(Br, "|" & Split(Bq(i), "_")(1))
            For j = 2 To UBound(Bs)
                If Bs(j, 4) = Split(Bq(i), "_")(1) And UBound(Bt) >= 0 Then
                    sPl = Split(Bt(Int(Rnd * (UBound(Bt) + 1))), "|")(0)
                    Bs(j, 5) = Split(sPl, "_")(2)
                    Bs(j, 6) = Split(sPl, "_")(1)
                    Br = Filter(Br, sPl, False)
                    Bt = Filter(Bt, sPl, False)
                End If
            Next
        Next
        .Cells(1).CurrentRegion = Bs
    End With
    Application.ScreenUpdating = True
End Sub

 

[Mari138]

Bedankt! Dit is zo te zien precies wat ik zoek. Leg het zo snel mogelijk voor bij de eindgebruiker.

"Statistisch gezien zal het soms voorkomen dat dezelfde speler meerdere keren achter elkaar op de bank komt terwijl een andere speler telkens opgesteld wordt. Vergelijk het met een loterij waarbij het lijkt alsof telkens dezelfde deelnemer wint. Ook is het zo dat een speler meer kans maakt te worden opgesteld naarmate hij of zij over meer competenties beschikt"

Dit zal in de praktijk geen probleem opleveren voor ons omdat het aantal spelers en de functies dadelijk redelijk in lijn gaan liggen.
In het voorbeeld is dit inderdaad extreem. Maar bedankt voor de toelichting!