vorrei sapere se esiste un sistema per sorteggiare dei gruppi
mi spiego avendo n°tot.di persone fare un sorteggio in modo che si possano creare tot.gruppi(il n°dei gruppi lo devo decidere io,come anche il n°di persone che appartengono al gruppo)
Moderatori: Anthony47, Flash30005
totopc ha scritto:mi scuso di tutto ma non sapevo di questi accorgimenti
mi sono iscritto da poco e non conoscevo le "regole"
comunque per quanto riguarda l'allegato del sorteggio sorteggia a coppie invece io vorrei mettendo per esempio che i gruppi debbano essere di 4 un sorteggio che mi formi dall'insieme di partenza (14 mi sembra)gruppi di 4 persone e i 2 che rimangono me li porta in due gruppi
esempio
a b c d e f g h i l m n o p = gruppo
voglio sorteggiare gruppi da 4
a b c d
e f g h sono 3 gruppi restano 2 nomi o p
i l m n
i restanti me li deve mettere uno in un gruppo e l'altro in altro gruppo (non mi interessa dove purche siano divisi)
Public Gr, RR, MRR As Integer
Sub Sorteggia()
Gr = 1
ContaGr = 0
Formato = 0
MRR = 2
UR = Range("A" & Rows.Count).End(xlUp).Row
UD = Range("C" & Rows.Count).End(xlUp).Row
If UD < 2 Then UD = 2
Range("C2:E" & UD + 1).Clear
Ripeti:
For Each S In Range("C2:C" & UR)
If S.Value = 0 Then
UA = Range("D" & Rows.Count).End(xlUp).Row + 1
If UA < 2 Then UA = 2
salta:
Cas = Int(Rnd() * (UR + 1))
If Cas < 2 Then Cas = 2
If Range("C" & Cas).Value > 0 Then GoTo salta
ContaGr = ContaGr + 1
Range("C" & Cas).Value = Gr
If ContaGr Mod 4 = 0 Then Gr = Gr + 1
Range("D" & UA).Value = Range("A" & Cas).Value
End If
Next S
ContaV = 0
For TV = 2 To UR
If Range("C" & TV).Value = 0 Then
ContaV = ContaV + 1
End If
Next TV
If ContaV > 0 Then GoTo Ripeti
If ContaGr Mod 4 <> 0 Then
Formato = 1
For Each R In Range("C2:C" & UR)
If R.Value = Gr Then
RUg:
CasR = Int(Rnd() * Gr)
If CasR = 0 Then GoTo RUg
If MCasR = CasR Then GoTo RUg
Range("C" & R.Row).Value = CasR
MCasR = CasR
End If
Next R
End If
Call SepGr
If Formato = 1 Then
Call TrovaRForm
End If
Range("D1").Select
End Sub
Sub SepGr()
Range("C2:D15").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Range("C1").Select
End Sub
Sub TrovaRForm()
UD = Range("C" & Rows.Count).End(xlUp).Row + 1
For TRF = 1 To Gr - 1
For RR = MRR To UD
If Range("C" & RR).Value <> TRF Then
Call FormGruppi
'TRF = Range("C" & RR).Value
GoTo SaltaR
End If
Next RR
SaltaR:
Next TRF
End Sub
Sub FormGruppi()
Range("C" & MRR & ":D" & RR - 1).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
MRR = RR
End Sub
totopc ha scritto:grazie lo sapevo che mi avreste risolto il problema siete grandi ho visto il file allegato e funziona bene
la macro nonl'ho provata ancora per tempo e perche devo vedere se mi riesce (non ho pratica)
volevo dire come si fa ad aggiungere o togliere concorrenti
mi spiego sono 14 concorrenti pero potrei fare questo sorteggio con 6 oppure con 60 oppure con 1000 (trattandosi di gruppi di persone)
non ce possibilita di inserire un comando che stabilisca prima il n°di persone e poi le sorteggi ?
grazie
totopc ha scritto:ho provato con il file ma mi scrive il concorrente pero quando premo sortegggio nella colonna D
non mi riporta il nome che ho scritto
totopc ha scritto:esempio
a b c d e f g h i l m n o p = gruppo
voglio sorteggiare gruppi da 4
a b c d
e f g h sono 3 gruppi restano o p
i l m n
i restanti me li deve mettere uno in un gruppo e l'altro in altro gruppo (non mi interessa dove purche siano divisi)
Torna a Applicazioni Office Windows
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 10 |
formula excel non visualizza risultato Autore: tommasog |
Forum: Applicazioni Office Windows Risposte: 6 |
Excel 2016 - Funzione SCARTO + INDIRETTO Autore: pl1957 |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 57 ospiti