da elenco iscritti sorteggio di coppie, terne, quadrette

[corvus44]

Saluti a tutti
Chissà se qualcuno dei super macronisti del Forum vorrà aiutarmi a realizzare il programma per la gestione delle:
GARE DI BOCCE A PUNTEGGIO
fornendo la macro atta ad eseguire il sorteggio delle formazioni, le altre macro necessarie al programma ( Svuotamento, Stampa cartellini, Ordinamento classifica, Stampa classifica) sono in grado di realizzarle, ma quella del sorteggio è decisamente fuori dalle mie capacità.
Alcune necessità per questo tipo di gara sono le medesime di quelle già evidenziate nel topic (“sorteggi random evitando certi tipi di abbinamento”), in cui ho avuto il decisivo contributo di Anthony, si inseriranno tutti i giocatori, quelli di categoria A o B con un “ * “ al fondo del nome, le donne con un “ % “, occorrerà evitare che nelle formazioni sorteggiate compaiono due simboli uguali., cioè che nella stessa formazione ci siano due giocatori di categoria A o B oppure due donne
Visto che la gara sarà strutturata su tre partite, occorrerà evitare che in 2à e 3à partita si riformino formazioni già sorteggiate.
Se le partite fossero tutte a coppie sarebbe già valida la macro del topic sopra menzionato (“sorteggi random evitando certi tipi di abbinamento”) , purtroppo per le bocce si è vincolati al numero campi disponibili, nel periodo invernale i campi coperti sono al max. 4 o 5 a seconda della bocciofila, occorrerà quindi fare gare miste con partite a coppie e terne oppure terne e quadrette a seconda degli iscritti.
La cosa più semplice è quella di lasciare decidere al direttore di gara quantità e tipologia di incontri a seconda del numero iscritti

Esempio per 26 giocatori e 5 campi disponibili ( max. n° giocatori 40)

Digita il numero partite per ogni tipologia
N° partite a coppie 2 (Q2) coppie da formare 4 per totale 8 giocatori
N° partite a terne 3 (Q3) terne da formare 6 per totale 18 giocatori
N° partite a quadrette (Q4) Nell'esempio in esame nessuna quadretta

Nel foglio 1( Iscritti) verranno digitate il numero delle partite nelle posizioni rispettivamente: per coppie (Q2), terne (Q3), quadrette (Q4), l'elenco degli iscritti ( variabile per ogni gara) sarà presente nella colonna U dello stesso foglio da riga 5 in poi.
Nel foglio 2 (Sorteggi) verranno disposti i sorteggi delle formazioni per le tre partite previste.

host image
FOGLIO ISCRITTI

url immagine
FOGLIO SORTEGGI
Nel foglio sorteggi ho ipotizzato due diverse possibili disposizioni delle formazioni ( verticale e orizzontale)
Sperando nell'aiuto di qualche buona anima saluto tutti gli amici del Forum

[mostrito78]

Ciao, scusami ma mi potresti spiegare come hai fatto il sorteggio random xche lo sto cercando per i tornei di calcio balilla, xo a me non serve sempre i sorteggi random evitando certi tipi di abbinamento ma anche un sorteggio classico che formi delle coppie casuali.
Ciao grazie

[GI49]

sono nuovo del forum e sarei interessato a questo programma per formare da una lista di nomi formazioni di coppie,terne o quadrette
che si devono poi incontrare casualmente in 2 turni successivi.
esiste una macro per fare ciò ? grazie

[Marius44]

Ciao Corvus44
non credi sarebbe meglio allegare un file su cui poter lavorare e tentare di trovare una soluzione?
Grazie.

Ciao,
Mario

[raimea]

mostrito78 » 14/08/2015, 9:35
Ciao, scusami ma mi potresti spiegare come hai fatto il sorteggio random xche lo sto cercando per i tornei di calcio balilla

x il calcio-balilla (bigliardino),
prova vedi questo:
http://www.lelugarine.eu/downloads.asp?id=682

ciao

[Flash30005]

Un salutone a tutti

@Raimea il link postato richiede l'accesso al sito per il download

ciao

[raimea]

ciao

@Raimea il link postato richiede l'accesso al sito per il download

si, lo so , solo che li' so di trovarlo sempre e non ho problemi di scadenza ecc..

comunque ora lo messo anche qui :

https://dl.dropboxusercontent.com/u/96374724/calciobalilla.rar

ciao

[corvus44]

Ciao a tutti
Per oltre un anno il mio post aveva avuto diverse visite ma nessuna risposta, io pur avendo alcune nozioni a livello dilettantistico, era dagli anni 90 che non scrivevo più una riga di codice (Clipper ediz. Summer 87) e non conoscevo ne V.B. ne V.B.A.
Questo Forum mi ha aiutato ( grazie.... Anthony) a realizzare il programma per la gestione delle gare di scopa utilizzabile anche per le gare di bocce a coppie, ma nessun aiuto è arrivato per questo post che doveva risolvere il problema delle estrazioni di coppie, terne, quadrette.
Gironzolando mesi e mesi per i vari Forum ho cercato di apprendere un po' di VBA ed ho iniziato a compilare la macro per la gestione delle estrazioni, dopo una infinità di inutili tentativi l'illuminazione mi è venuta da una macro ( molto ben commentata) di Alexsandra, scovata non so più dove, che mi ha permesso insieme a scopiazzate dalle macro di Anthony e Ricky di ottenere un discreto risultato (per me).
Purtroppo il risultato è solo parziale perché la macro esegue:
I sorteggi di tre partite ,inserendo tutti i giocatori, quelli di categoria A o B con un “ * “ al fondo del nome, le donne con un “ % “, evita che nelle formazioni sorteggiate compaiono due simboli uguali., cioè che nella stessa formazione ci siano due giocatori di categoria A o B oppure due donne, però non controlla che in 2à e 3à partita si possano riformare formazioni già sorteggiate
Visto l'interessamento dimostrato negli ultimi mesi da: Mostrito78, GI49, Marius44 ecc.. ho deciso di inserire la macro, spero che a qualcuno possa servire e che magari possa migliorarla, il funzionamento richiede l'inserzione di due fogli:
Nel foglio " ISCRITTI" inserire i nominativi dei partecipanti in colonna B da riga 5 in giù, nelle celle R2, R3,R4 inserire rispettivamente il numero di formazioni a coppie, terne e quadrette.
Nel foglio " SORTEGGI" io ho formattato la larghezza colonne B-C-H,M a 2, le altre colonne da A a Q a 14,
le formazioni sorteggiate si presenteranno in orizzontale, formazione di riga pari contro formazione di riga dispari.

Allego la macro per i sorteggi
saluti a tutti

Codice: Seleziona tutto

Sub AcasoGiallo()
 Dim iRow As Integer, nter As Integer, ncop As Integer, nquadr As Integer
 
 Worksheets("sorteggi").Select
 Range("a1", "q50").ClearContents
Set sorg = Sheets("iscritti").Range("b5")
Z = 1
GIOC = 0
For Each cell In Range(sorg, sorg.End(xlDown))
   y = Z & "-" & cell.Value
   Z = Z + 1
   GIOC = GIOC + 1
   Range("A" & Z - 1) = y
 Next cell
 
inizio:

nquadr = Sheets("iscritti").Range("R4")
nter = Sheets("iscritti").Range("R3")
ncop = Sheets("iscritti").Range("R2")
contr = 1
If (nquadr * 4) + (nter * 3) + (ncop * 2) > GIOC Then GoTo Abort ' controlla che numero formazioni e totale giocatori sia congruo
For j = 1 To 3' ciclo per eseguire estrazioni di tre partite
'si rispristina il colore delle celle della colonna A (i nomi)
Range([A1], [A50]).Interior.ColorIndex = xlNone
Select Case j ' C = fattore di correzione per selezionare la colonna inizio di ogni estrazione
Case Is = 1
c = 0
Case Is = 2
c = 5
Case Is = 3
c = 10
End Select

10: 'INIZIO CICLO QUADRETTE
If nquadr = 0 Then GoTo 50 ' se numero quadrette è zero manda a estrazione terne
For Nq = 1 To nquadr
Randomize
15: 'indice riga codice primo estratto quadrette
contr = 0
contr = contr + 1
quale = Int(GIOC * Rnd) + 1
If contr > 10000 Then GoTo abortA
'estratto il numero, si controlla se la cella è gialla,
'in questo caso si torna all'indice riga 15 'e si ripete il ciclo di randomizzazione
If Cells(quale, 1).Interior.ColorIndex = 6 Then GoTo 15
'altrimenti si prosegue
primo = Cells(quale, 1).Value
'si colora di giallo la cella estratta in colonna 1
Cells(quale, 1).Interior.ColorIndex = 6
iRow = 1
While Cells(iRow, 4 + c) <> "" ' si cerca la prima riga libera della zona estrazioni
iRow = iRow + 1
Wend
Cells(iRow, 4 + c).Value = primo ' si inserisce su riga trovata libera
contr = 0
20: 'indice riga codice secondo estratto quadrette

contr = contr + 1
quale = Int(GIOC * Rnd) + 1
If contr > 10000 Then GoTo abortA
If Cells(quale, 1).Interior.ColorIndex = 6 Then GoTo 20
secondo = Cells(quale, 1).Value
'si controlla che davanti ad entrambe i nomi del primo e secondo estratto non compaia "%" oppure "*"
If Right(secondo, 1) = "%" And Right(primo, 1) = "%" Then GoTo 20 'se simboli di primo e secondo sono uguali ritorno a 20
If Right(secondo, 1) = "*" And Right(primo, 1) = "*" Then GoTo 20
'altrimenti si prosegue
Cells(quale, 1).Interior.ColorIndex = 6
iRow = 1
While Cells(iRow, 5 + c) <> ""
iRow = iRow + 1
Wend
Cells(iRow, 5 + c).Value = secondo
contr = 0
30: 'indice riga codice terzo estratto quadrette

contr = contr + 1
quale = Int(GIOC * Rnd) + 1
If contr > 10000 Then GoTo abortA
If Cells(quale, 1).Interior.ColorIndex = 6 Then GoTo 30
terzo = Cells(quale, 1).Value
If Right(secondo, 1) = "%" And Right(terzo, 1) = "%" Or Right(primo, 1) = "%" And Right(terzo, 1) = "*" Then GoTo 30
If Right(secondo, 1) = "*" And Right(terzo, 1) = "*" Or Right(primo, 1) = "*" And Right(terzo, 1) = "*" Then GoTo 30
Cells(quale, 1).Interior.ColorIndex = 6
iRow = 1
While Cells(iRow, 6 + c) <> ""
iRow = iRow + 1
Wend
Cells(iRow, 6 + c).Value = terzo
contr = 0

40: 'indice riga codice quarto estratto quadrette

contr = contr + 1
quale = Int(GIOC * Rnd) + 1
If contr > 10000 Then GoTo abortA
If Cells(quale, 1).Interior.ColorIndex = 6 Then GoTo 40
quarto = Cells(quale, 1).Value
If Right(primo, 1) = "%" And Right(quarto, 1) = "%" Or Right(secondo, 1) = "%" And Right(quarto, 1) = "%" Or Right(terzo, 1) = "%" And Right(quarto, 1) = "%" Then GoTo 40
If Right(primo, 1) = "*" And Right(quarto, 1) = "*" Or Right(secondo, 1) = "*" And Right(quarto, 1) = "*" Or Right(terz0, 1) = "*" And Right(quarto, 1) = "*" Then GoTo 40

Cells(quale, 1).Interior.ColorIndex = 6
iRow = 1
While Cells(iRow, 7 + c) <> ""
iRow = iRow + 1
Wend
Cells(iRow, 7 + c).Value = quarto
contr = 0
Next Nq

50: 'INIZIO CICLO TERNE
If nter = 0 Then GoTo 80 ' se numero terne è zero manda a estrazione coppie
For Nt = 1 To nter
Randomize
55: 'indice riga codice primo estratto terne
contr = contr + 1
quale = Int(GIOC * Rnd) + 1
If contr > 10000 Then GoTo abortA
If Cells(quale, 1).Interior.ColorIndex = 6 Then GoTo 55
primo = Cells(quale, 1).Value
Cells(quale, 1).Interior.ColorIndex = 6
iRow = 1
While Cells(iRow, 4 + c) <> ""
iRow = iRow + 1
Wend
Cells(iRow, 4 + c).Value = primo
contr = 0
60: 'indice riga codice secondo estratto terne
contr = contr + 1
quale = Int(GIOC * Rnd) + 1
If contr > 10000 Then GoTo abortA
If Cells(quale, 1).Interior.ColorIndex = 6 Then GoTo 60
secondo = Cells(quale, 1).Value
If Right(secondo, 1) = "%" And Right(primo, 1) = "%" Then GoTo 60
If Right(secondo, 1) = "*" And Right(primo, 1) = "*" Then GoTo 60
Cells(quale, 1).Interior.ColorIndex = 6
iRow = 1
While Cells(iRow, 5 + c) <> ""
iRow = iRow + 1
Wend
Cells(iRow, 5 + c).Value = secondo
contr = 0
70: 'indice riga codice terzo estratto terne
contr = contr + 1
quale = Int(GIOC * Rnd) + 1
If contr > 10000 Then GoTo abortA
If Cells(quale, 1).Interior.ColorIndex = 6 Then GoTo 70
terzo = Cells(quale, 1).Value

If Right(secondo, 1) = "%" And Right(terzo, 1) = "%" Or Right(primo, 1) = "%" And Right(terzo, 1) = "%" Then GoTo 70
If Right(secondo, 1) = "*" And Right(terzo, 1) = "*" Or Right(primo, 1) = "*" And Right(terzo, 1) = "*" Then GoTo 70

Cells(quale, 1).Interior.ColorIndex = 6
iRow = 1
While Cells(iRow, 6 + c) <> ""
iRow = iRow + 1
Wend
Cells(iRow, 6 + c).Value = terzo
Next Nt

80: 'INIZIO CICLO DELLE COPPIE

Nc = 0
contr = 0
If ncop = 0 Then GoTo 95

For Nc = 1 To ncop
Randomize
85:
contr = contr + 1
quale = Int(GIOC * Rnd) + 1
If contr > 10000 Then GoTo abortA
If Cells(quale, 1).Interior.ColorIndex = 6 Then GoTo 85
primo = Cells(quale, 1).Value
Cells(quale, 1).Interior.ColorIndex = 6
iRow = 1
While Cells(iRow, 4 + c) <> ""
iRow = iRow + 1
Wend
Cells(iRow, 4 + c).Value = primo
contr = 0
90:
contr = contr + 1
quale = Int(GIOC * Rnd) + 1
If contr > 10000 Then GoTo abortA
If Cells(quale, 1).Interior.ColorIndex = 6 Then GoTo 90
secondo = Cells(quale, 1).Value

If Right(secondo, 1) = "%" And Right(primo, 1) = "%" Then GoTo 90
If Right(secondo, 1) = "*" And Right(primo, 1) = "*" Then GoTo 90

Cells(quale, 1).Interior.ColorIndex = 6
iRow = 1
While Cells(iRow, 5 + c) <> ""
iRow = iRow + 1
Wend
Cells(iRow, 5 + c).Value = secondo
contr = 0
Next Nc
95:
Next j
100: MsgBox ("COMPLETATO, premere ok per terminare")
Application.CutCopyMode = False
Exit Sub

Abort:
MsgBox ("Tentativo fallito, numero formazioni non congrue con num. giocatori")
Sheets("iscritti").Select
    Range("R2").Select
Application.CutCopyMode = False
Exit Sub

abortA:
MsgBox ("Tentativo fallito, PREMERE OK PER RIPROVARE")
 Range("b1", "q50").ClearContents
GoTo inizio

End Sub