Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Sorteggio e abbinamento a squadre

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

Sorteggio e abbinamento a squadre

Postdi bulle » 12/12/15 10:36

Ciao, salve a tutti.
Per dei tipi di gara che stiamo facendo molto spesso ultimamente, mi servirebbe un codice che mi aiuti a sorteggiare e fare gli abbinamenti a squadre che a mano è un manicomio.

Mi spiego meglio e cerco di farvi capire di cosa ho bisogno facendo un esempio a 12 persone disegnando il primo turno prendendo come giudice l'ultima riga

1 . 2 . 3 . 4
5 . 6 . 7 . 8
9 . 10 . 11 . 12
A . B . C . D

In questo esempio, guardandolo in verticale si può vedere che durante il primo turno di gara nel picchetto A si sfidano 1 e 5, giudice 9 picchetto A.
Le altre regole del torneo, e che dovrebbe seguire anche il codice sono:
la gara si svolge sempre in 9 turni, se sono presenti più partecipanti aumentano le postazioni (E,F,G...)

In questi 9 turni il "codice" deve creare degli abbinamenti sempre diversi es (se nel primo turno si sfida 1 contro 5 non possono essere abbinati nuovamente in nessun altro turno) in più deve dare la possibilità ai partecipanti di spostarsi sui diversi picchetti durante i 9 turni e non di farli stare sempre nei soliti picchetti nei 6 turni di sfida

Deve tener conto che ogni partecipante per 3 turni fa da giudice e per 6 si sfida (ovviamente non è un problema se capita che sono attaccati, anche se sarebbe meglio che non accada cosi ogni tanto uno si riposa)

I dati massimi che deve gestire sono:
45 partecipanti
15 picchetti
9 turni

Vi ringrazio anticipatamente perché vedo nel resto del forum che siete molto competenti e cordiali, se mi sono spiegato male in qualche punto sono disponibile a ulteriori chiarimenti.
bulle
Newbie
 
Post: 6
Iscritto il: 10/12/15 02:42

Sponsor
 

Re: Sorteggio e abbinamento a squadre

Postdi Anthony47 » 14/12/15 15:45

Ciao bulle, benvenuto nel forum.
Personalmente non ho capito le regole del gioco... Per cominciare:
Ci sono un numero di partecipanti compresi tra ?? e 45
Devono essere orgnizzati 9 turni di quante partite a turno?
Postazione e picchetto sono la stessa cosa? Sono una variabile dipendente (da che cosa) o indipendente?

Poi vedremo.
Ti aspettiamo con queste informazioni....
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13894
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Sorteggio e abbinamento a squadre

Postdi Flash30005 » 15/12/15 09:41

Benvenuto anche da parte mia

Se ho interpretato correttamente la richiesta
questa macro dovrebbe soddisfare la richiesta
Codice: Seleziona tutto
Sub SortSq()
Part = [A1]  '<<<< cella con il numero dei partecipanti
If Part Mod 3 > 0 Then
MsgBox "Correggere il numero dei partecipanti (non sono multiplo di 3)", vbCritical
Exit Sub
End If
Picc = Part / 3
Range("M1:AD1000").ClearContents

For Turno = 1 To 9
    RR = Turno + 1 + (4 * (Turno - 1))
    Range("M" & RR - 1).Value = "T" & Turno
    Range("M" & RR).Value = "SF1"
    Range("M" & RR + 1).Value = "SF2"
    Range("M" & RR + 2).Value = "A"
    For CC = 14 To 13 + Picc
RicasPic:
        NoP = 1
        Dim VP(3)
        For RRT = RR To RR + 2
            If RRT = RR Then
                Cells(RR - 1, CC).Value = CC - 13

            End If
Ricas:
            P = Int(Rnd() * Part) + 1
            If Application.WorksheetFunction.CountIf(Range(Cells(RR, 14), Cells(RR + 2, 28)), P) > 0 Then GoTo Ricas
            Cells(RRT, CC).Value = P
            VP(NoP) = P
            NoP = NoP + 1
        Next RRT
        URC = Range("AD" & Rows.Count).End(xlUp).Row + 1
        For NP = 1 To 45
            For NoP = 1 To 3
                If VP(NoP) = NP Then
                    Range("AD" & URC).Value = "'" & Range("AD" & URC).Value & Format(VP(NoP), "00")
                End If
            Next NoP
        Next NP
        If Application.WorksheetFunction.CountIf(Range("AD1:AD" & URC - 1), Range("AD" & URC)) > 0 Then
        Range("AD" & URC).ClearContents
            Range(Cells(RR, CC), Cells(RR + 2, CC)).ClearContents
            GoTo RicasPic
        End If
    Next CC
Next Turno
Columns(30).ClearContents
End Sub


In A1 inserirai il numero dei partecipanti
e avviando la macro "SortSq" avrai i Picchetti trascritti dalla colonna M verso destra (alla colonna AB per 45 partecipanti)
e i turni nelle righe successive (ognuno avrà una testata e una fiancata
Utilizzo della colonna AD come appoggio che viene eliminata a fine sorteggio


Ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Sorteggio e abbinamento a squadre

Postdi bulle » 15/12/15 11:38

Ciao e grazie a tutti per il benvenuto.
Le regole sono semplici:
I partecipanti sono variabili, da min 12 a 45 (a seconda di quanti riusciamo a far venire) sono rigorosamente multipli di 3!), a seconda del numero dei partecipanti ci sono più postazioni (picchetti è la solita cosa) il numero dei picchetti è dato dal numero dei partecipanti diviso 3.
i turni sono 9, in un turno tutti i partecipanti sono chi in pesca e chi a far da giudice.
In questi 9 turni ogni pescatore dovrà fare per 3 volte (turni) il giudice e per 6 dovrà pescare, in queste 6 volte che pesca dovrà pescare sempre con un numero diverso.

la macro che ha fatto flash ci si avvicina molto (grazie), l'ho provata e per le prove che ho fatto ho visto che ad alcuni capita 4 volte giudice e non va bene, (3 turni da giudice, 6 turni in pesca), e ad alcuni capita che si sfidano più di una volta (es. il 17 si sfida con il 21 nel turno 2 e nel turno 9, invece dev' essere che una volta sorteggiati non devono più trovarsi in sfida insieme)
Anche la disposizione non è ottimale, ma a quella credo di riuscire a spostarmela da me.

Grazie mille a tutti per il tempo che mi state dedicando!!!
bulle
Newbie
 
Post: 6
Iscritto il: 10/12/15 02:42

Re: Sorteggio e abbinamento a squadre

Postdi bulle » 15/12/15 11:57

Mi sono scordato di scrivere quello che mi aveva chiesto Anthony, faccio un esempio per vedere se riesco a farvi capire

i turni sono partite da 15 min, es a 12 part.:

1 Turno

1 contro 2, giudice 3, picchetto A
4 contro 5, giudice 6, picchetto B
7 contro 8, giudice 9, picchetto C
10 contro 11, giudice 12, picchetto D

Per 15 minuti:
nel picchetto A l'1 sfida il 2, il 3 segna le catture, alla fine chi ne ha di più prende 3 punti.
nel picchetto B il 4 sfida il 5, il 6 segna le catture, alla fine chi ne ha di più prende 3 punti.
nel picchetto C il 7 sfida l' 8, il 9 segna le catture, alla fine chi ne ha di più prende 3 punti.
nel picchetto D il 10 sfida l'11, il 12 segna le catture, alla fine chi ne ha di più prende 3 punti.

è per questo motivo che non possono sfidarsi più di una volta le solite 2 persone. se ti capita sempre quello scarso fai sempre 3 punti.

Fine primo turno si segnano i punti e si va avanti con i turni successivi.
Alla fine dei nove turni chi ha più punti va in semifinale, finale etc...

Grazie ancora a tutti!!!!
bulle
Newbie
 
Post: 6
Iscritto il: 10/12/15 02:42

Re: Sorteggio e abbinamento a squadre

Postdi Flash30005 » 16/12/15 02:08

Con questa macro modificata un partecipante non farà più di 3 volte l'arbitro
non si scontrerà per tutti e nove i turni con uno stesso partecipante

Codice: Seleziona tutto
Sub SortSq2()
Part = [A1]
If Part Mod 3 > 0 Then
MsgBox "Correggere il numero dei partecipanti (non sono multiplo di 3)", vbCritical
Exit Sub
End If
Picc = Part / 3
ContaFall = 0
Resettaggio:
Range("M1:AE1000").ClearContents
For Turno = 1 To 9
RicomT:
ContatF = 0
    RR = Turno + 1 + (4 * (Turno - 1))
    Range("M" & RR - 1).Value = "T" & Turno
    Range("M" & RR).Value = "SF1"
    Range("M" & RR + 1).Value = "SF2"
    Range("M" & RR + 2).Value = "A"
    For CC = 14 To 13 + Picc
RicasPic:
        NoP = 1
        Dim VP(2)
        For RRT = RR To RR + 2
            If RRT = RR Then
                Cells(RR - 1, CC).Value = CC - 13
            End If
Ricas:
ContatF = ContatF + 1
If ContatF > 10000 Then
URC = Range("AD" & Rows.Count).End(xlUp).Row
URAr = Range("AE" & Rows.Count).End(xlUp).Row
Range("AD" & URC - (CC - 14) & ":AD" & URC).ClearContents
Range("AE" & URAr - (CC - 14) & ":AE" & URAr).ClearContents
Range("M" & RR - 1 & ":AB" & RR + 2).ClearContents
ContaFall = ContaFall + 1
If ContaFall > 30 Then GoTo Resettaggio
GoTo RicomT
End If
            P = Int(Rnd() * Part) + 1
            If Application.WorksheetFunction.CountIf(Range(Cells(RR, 14), Cells(RR + 2, 28)), P) > 0 Then GoTo Ricas
            Cells(RRT, CC).Value = P
            If RRT = RR + 2 Then
            URAr = Range("AE" & Rows.Count).End(xlUp).Row + 1
            If Application.WorksheetFunction.CountIf(Range("AE1:AE" & URAr - 1), P) > 2 Then GoTo Ricas
            Range("AE" & URAr).Value = P
            Else
            VP(NoP) = P
            NoP = NoP + 1
            End If
        Next RRT
        URC = Range("AD" & Rows.Count).End(xlUp).Row + 1
        For NP = 1 To 45
            For NoP = 1 To 2
                If VP(NoP) = NP Then
                    Range("AD" & URC).Value = "'" & Range("AD" & URC).Value & Format(VP(NoP), "00")
                End If
            Next NoP
        Next NP
        If Application.WorksheetFunction.CountIf(Range("AD1:AD" & URC - 1), Range("AD" & URC)) > 0 Then
        Range("AD" & URC).ClearContents
            Range(Cells(RR, CC), Cells(RR + 2, CC)).ClearContents
            GoTo RicasPic
        End If
    Next CC
Next Turno
'Columns(30).ClearContents
'Range("AD:AF").ClearComments  '<<<scommentare per eliminare il conteggio arbitri
End Sub


Ho lasciato le colonne di appoggio
in colonna AE hai l'elenco degli arbitrio e potrai fare una verifica con la formula Conta.se per vedere se i 45 partecipanti fanno più di3 volte l'arbitro
togliendo il commento alla riga codice a fine macro le colonne di appoggio saranno ripulite.

ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Sorteggio e abbinamento a squadre

Postdi bulle » 16/12/15 09:10

Ho provato e ho visto che capita il contrario, ovvero 7 volte in pesca e 2 giudice.
poi a volte quando eseguo la macro excel va in loop infinito, ho office 2016.
Comunque se a volte si blocca va bene lo stesso, lo riavvio e festa finita, ma se mi mette 7 volte in pesca non va bene xche non è una cosa equa per il resto dei partecipanti, se riesci a mettere il limite anche a 6 volte in pesca sarebbe perfetto, deve essere proprio una regola, 6 volte in pesca e 3 giudice (preferibilmente non tutti attaccati).
grazie ancora!!
bulle
Newbie
 
Post: 6
Iscritto il: 10/12/15 02:42

Re: Sorteggio e abbinamento a squadre

Postdi Anthony47 » 17/12/15 01:09

Per puro esercizio ho sviluppato questo file:
https://www.dropbox.com/s/xn957xuurf6pp ... .xlsm?dl=0
Va compilata la cella B1e poi eseguita la macro Compila, attivabile tramite il pulsante presente sul foglio.
Gli elenchi saranno compilati in colonna D (il Turno), E (i giocatori), F (il giudice) e C (la postazione).

Il resto del foglio e' di appoggio per i calcoli e per il controllo.

Mi sembra strano che ci sono pochi conflitti, quindi non sono certo che le situazioni errate le abbia realmente intercettate; pertanto ho preferito lasciare due "Stop" per possibili errori (righe If Range("EMax") > 1 Then Stop); se si fermasse in quella posizione ne parleremo...

Il foglio e' protetto ma senza password.

Ciao, fai sapere...
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13894
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Sorteggio e abbinamento a squadre

Postdi bulle » 19/12/15 17:43

Si a volte è successo che si bloccasse li aprendo il VBA in debug, ma capita cosi poche volte che non è un problema, basta chiudere e ri premere compila.
veramente ottima interpretazione di ciò che volevo, è quasi perfetto!! ma alle cavolate ci penso io, tipo chiamare i picchetti a,b,c,d,etc... e fare una stampa oltre a quella una che segua numero per numero, es:
se io sono il numero 1 devo avere in mano un bigliettino del genere:

partecipante 1

turno | pesca 1 | pesca 2 | giudice | picchetto
1 | X | X | 1 | A
2 | 1 | X | X | C
3 | X | 1 | X | B
4 | X | X | 1 | D


insomma una scheda riepilogativa di dove deve essere il partecipante per poterla stampare e dare a tutti da poter vedere dove devono andare...
grazie mille ottimo lavoro..
bulle
Newbie
 
Post: 6
Iscritto il: 10/12/15 02:42

Re: Sorteggio e abbinamento a squadre

Postdi Anthony47 » 19/12/15 21:20

Si a volte è successo che si bloccasse li aprendo il VBA in debug, ma capita cosi poche volte che non è un problema, basta chiudere e ri premere compila.
Mannaggia... a me pero' non e' mai successo, eppure di prove ne ho fatte tante... Provero' ancora ma mi sa che te lo tieni cosi' :D :D

Ciao!
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13894
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Sorteggio e abbinamento a squadre":


Chi c’è in linea

Visitano il forum: Nessuno e 29 ospiti