1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
| Sub alea()
Application.ScreenUpdating = False
Columns("A:A").Copy
Sheets("Points").Range("A1").PasteSpecial
dl = Range("A" & Rows.Count).End(xlUp).Row
Range(Cells(2, 2), Cells(dl, 2)).FormulaR1C1 = "=RAND()"
ActiveWorkbook.Worksheets("Liste des inscrit").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Liste des inscrit").Sort.SortFields.Add Key:=Range _
("B2:B" & dl), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Liste des inscrit").Sort
.SetRange Range("A1:B" & dl)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:A").Copy
Sheets("Manche 1").Range("A1").PasteSpecial
Application.CutCopyMode = False
Application.Calculate
ActiveWorkbook.Worksheets("Liste des inscrit").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Liste des inscrit").Sort.SortFields.Add Key:=Range _
("B2:B" & dl), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Liste des inscrit").Sort
.SetRange Range("A1:B" & dl)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:A").Copy
Sheets("Manche 2").Range("A1").PasteSpecial
Application.CutCopyMode = False
n = Range("table")
reste = (dl - 1) Mod n
Dim taille(5) As Integer
For i = 0 To n - 1
taille(i) = Application.WorksheetFunction.RoundDown((dl - 1) / n, 0)
Next i
For j = 0 To reste - 1
taille(j) = taille(j) + 1
Next j
For i = n - 2 To 0 Step -1
taille(i) = taille(i) + taille(i + 1)
Next i
taille(0) = taille(0) - 1
For i = n - 1 To 0 Step -1
On Error Resume Next
Debug.Print dl - taille(i)
Sheets("Manche 1").Cells(dl - taille(i), 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Manche 1").Cells(dl - taille(i), 1) = "table " & n
Sheets("Manche 2").Cells(dl - taille(i), 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Manche 2").Cells(dl - taille(i), 1) = "table " & n
n = n - 1
On Error GoTo 0
Next i
Columns(2).EntireColumn.Delete
Application.ScreenUpdating = True
End Sub |
Partager