Condividi:        

sorteggi casuali evitando però certi tipi di abbinamento

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

sorteggi casuali evitando però certi tipi di abbinamento

Postdi cesfri » 09/03/22 18:26

Salve a tutti
Sono un nuovo iscritto, ma seguo il forum da tempo, volevo sapere se c’è qualcuno che possa aiutarmi nel creare una macro per il seguente problema.
Ho un elenco di giocatori che si iscrivono a coppie, ad esempio:
a1 – a2
b1 – b2
c1 – c2
d1 – d2
e1 – e2
ecc..
Le gare che devono affrontare sono di 5 o 6 giocatori alla volta e in ogni gara non devono trovarsi due concorrenti appartenenti alla stessa coppia.
In base al numero totale dei giocatori devo formare i gruppi da 5 o da 6 (preferenza 5, ad esempio se sono 30 iscritti 6 gruppi da 5 – se gli iscritti sono 32 4 gruppi da 5 e 2 gruppi da 6) in modo però che due concorrenti appartenenti alla stessa coppia non si trovino assieme.
Esiste qualcuno nel forum che abbia tempo e voglia di aiutarmi?
Dimenticavo io uso Office 365
Saluti e grazie
cesfri
Newbie
 
Post: 2
Iscritto il: 09/03/22 14:58

Sponsor
 

Re: sorteggi casuali evitando però certi tipi di abbinamento

Postdi Anthony47 » 10/03/22 01:36

Intanto "Benvenuto nel forum"

Quanto segue e' un "lavoro di forza", cioe' di prova e riprova fini ad avere i gruppi che soddisfano la regola.

Supponiamo che i concorrenti siano registrati in A2-B2 e sottostanti (le coppie nella stessa riga)

In F2 e sottostanti scrivi la dimensione dei gruppi che vuoi ritrovare, e nella colonna accanto scrivi quanti gruppi di quella dimensione vuoi creare. E' ovvio che devi fare in modo che gli iscritti richiesti per creare quei gruppi siano disponibili in colonne A:B

Immagine

Per aiutarmi ho calcolato in E2 quanti iscritti sono presenti, usando la formula
Codice: Seleziona tutto
=CONTA.VALORI(A2:B50)
(max 50 coppie)

Ho riservato l'area arancione alla dichiarazione della dimensione e del numero di gruppi
Avendo nel mio test 40 iscritti ho impostato 2 gruppi di 5 e 5 gruppi da 6

In H2 ho calcolato quanti iscritti servono per creare quei gruppi, usando la formula
Codice: Seleziona tutto
=F3*G3+F2*G2+F4*G4+F5*G5


La verifica tra iscritti presenti e iscritti richiesti per creare quei gruppi va fatta a occhio, se hai paura di sbagliare puoi aggiungere una formattazione condizionale che evidenzia se i due valori (E2 e H2) sono diversi.

Creero' i gruppi a partire da L2: verso il basso i componenti del gruppo, verso destra i gruppi successivi

Ho inserito un ulteriore controllo nelle colonne C:D, per contare quante volte quell'iscritto e' presente nei risultati.
Per questo ho usato in C2 la formula
Codice: Seleziona tutto
=CONTA.SE($L$2:$U$9;A2)

(ho supposto che creeremo max 10 gruppi; allarga l'intervallo L:U se pensi di avere piu' gruppi)

Poi copia C2 verso il basso, e la colonna C copiala in D
Dovra' essere verificato che ogni iscritto compare in un solo gruppo, e tutti gli iscritti compaiono in un gruppo (che corrisponde ad avere una coppia di 1 accanto a ogni coppia iscritta)

La macro che gestisce tutto questo:
Codice: Seleziona tutto
Sub CreaGruppi()
Dim Definiz As String, Risult As String, Gruppi As Long
Dim I As Long, grCnt As Long, J As Long, K As Long
Dim PlaARR, dEst As Range, rndI As Long, dLock As Long
Dim myTim As Single, hMany As Long
'
Definiz = "F2"
Risult = "L1"

myTim = Timer
reTry:
Range(Risult).CurrentRegion.ClearContents
Beep
dLock = 0: grCnt = 0
PlaARR = Split(Application.WorksheetFunction.TextJoin("-", True, Range("A2:B50")), "-", , vbTextCompare)
Gruppi = Application.WorksheetFunction.CountA(Range(Definiz).Resize(20, 1))
For I = 1 To Gruppi
    hMany = Range(Definiz).Offset(I - 1, 0).Value
    For J = 1 To Range(Definiz).Offset(I - 1, 1).Value
        For K = 1 To hMany
            Set dEst = Range(Risult).Offset(0, grCnt)
            Do
                DoEvents
                rndI = Int((UBound(PlaARR) + 1) * Rnd)
                If PlaARR(rndI) <> "" And Left(PlaARR(rndI), 2) <> (CStr(grCnt) & "#") Then
                    If InStr(1, PlaARR(rndI), "#", vbTextCompare) > 0 Then
                        dEst.Offset(100, 0).End(xlUp).Offset(1, 0) = Mid(PlaARR(rndI), 3)
                        If Len(Mid(PlaARR(rndI), 3)) < 1 Then Stop
                    Else
                        dEst.Offset(100, 0).End(xlUp).Offset(1, 0) = PlaARR(rndI)
                        If Len(PlaARR(rndI)) < 1 Then Stop
                    End If
                    PlaARR(rndI) = ""
                    If Application.WorksheetFunction.IsEven(rndI) Then
                        If PlaARR(rndI + 1) <> "" Then PlaARR(rndI + 1) = grCnt & "#" & PlaARR(rndI + 1)
                    Else
                        If PlaARR(rndI - 1) <> "" Then PlaARR(rndI - 1) = grCnt & "#" & PlaARR(rndI - 1)
                    End If
                    Exit Do
                Else
                    dLock = dLock + 1
                End If
                If dLock > 3000 Then
                    GoTo reTry
                End If
                If (Timer - myTim) > 30 Then
                    MsgBox ("Fallito")
                    Exit Sub
                End If
            Loop
        Next K
        grCnt = grCnt + 1
    Next J
Next I
End Sub

Copia il codice e incollalo in un "Modulo standard" del tuo vba. Per come fare segui le informazioni che trovi qui: viewtopic.php?f=26&t=103893&p=647675#p647675

E' presente un timeout di 30 secondi; se entro questo tempo i gruppi non sono stati completati allora la macro termina con un messaggio di errore; e' probabile che se rilanci la macro sia piu' fortunato

Usa il foglio con i soli dati che ho detto, quindi eventuali tue elaborazioni falle in un foglio diverso

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 19465
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: sorteggi casuali evitando però certi tipi di abbinamento

Postdi cesfri » 11/03/22 10:42

Perfetto proprio quello che volevo.
Sei grande.
Grazie mille.
cesfri
Newbie
 
Post: 2
Iscritto il: 09/03/22 14:58


Torna a Applicazioni Office Windows


Topic correlati a "sorteggi casuali evitando però certi tipi di abbinamento":


Chi c’è in linea

Visitano il forum: Nessuno e 8 ospiti

cron