Salve a tutti,
sono un nuovo utente inesperto ma interessato, voglio ringraziare Flash30005 per il suo aiuto e consiglio.
In questo momento sono alle prese con la realizzazione di un file excel per i tornei di pallavolo di mio figlio dato che hanno un sistema praticamente manuale vorrei poter dare il mio contributo per velocizzare e ridurre i tempi durante l'evento.
In questa fase sono alle prese con la parte di sorteggio delle squadre che sono 40 e li devo suddividere in circa 10 gironi mischiando ovviamente, ho analizzato una parte interessante presa da un vostro post e grazie all'aiuto di Fash30005 è stata semplificata e funziona alla grande solo che io non mi intendo di VBA, anche se trovo interessante il tutto mi riesce comunque difficile, vi inserisco il codice modificato e se qualcuno puoi aiutarmi con delle spiegazioni su come modificare le posizioni ve ne sarei grato:
- Codice: Seleziona tutto
Public RR As Integer, SS As Integer, I As Integer, J As Integer
Public Numero_casuale As Integer, Riga_Inizio As Integer
Sub Sorteggia_Coppie()
' Tutte le coppie da sorteggiare sono in colonna "D" e "E" del Foglio1 = Coppie_Concorrenti
' Le copiie sorteggiate sono in colonna "D" e "E" del Foglio2 = Coppie_Sorteggiate
' Per colonne divese da "D" (colonna 4) e "E" (colonna 5) modificare le istruzioni che fanno riferimenti a queste colonne e valori
' dove trovi la parola "QUI"
RR = Foglio1.Range("D" & Rows.Count).End(xlUp).Row
SS = Foglio2.Range("D" & Rows.Count).End(xlUp).Row
Riga_Inizio = 8
If SS < 8 Then SS = Riga_Inizio
Foglio2.Range("D" & Riga_Inizio & ":E" & SS).ClearContents
SS = 8
Application.ScreenUpdating = False
For I = Riga_Inizio To RR
Riprova:
Numero_casuale = Int((RR - 7) * Rnd()) + 1
If Foglio2.Cells(Numero_casuale + 7, 4) <> "" Then GoTo Riprova
Foglio2.Cells(Numero_casuale + 7, 4) = Foglio1.Cells(I, 4)
Foglio2.Cells(Numero_casuale + 7, 5) = Foglio1.Cells(I, 5)
Next I
MsgBox "Sono state sorteggiate '" & RR - Riga_Inizio + 1 & "' Coppie in modo casuale"
Application.ScreenUpdating = True
Foglio2.Select
[D8].Select
End Sub
Vorrei cambiare posizioni delle squadre dato che ho creato una macro che mi inserisce le squadre.
Ringrazio anticipatamente.
Un saluto
Alessandro
EDIT Flash 30/03/2016: - Inserita macro nel Tag Code