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
67
68
69
70
71
72
73
74
75
| Option Explicit
Const Nb As Byte = 5 'Nombre de manches
Dim n As Long
Dim R As Long
Sub TRAITEMENT()
Dim LastLig As Long, i As Long, j As Long
Dim TB() As Long, RES() As String
Dim k As Byte
Dim PART
With Feuil1
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
PART = .Range("A2:A" & LastLig) 'Plage des participants
n = UBound(PART, 1)
R = n / 4
ReDim TB(1 To n, 1 To Nb)
For k = 1 To Nb
EQUIPES TB, k
Next k
ALEAT PART
ReDim RES(1 To R, 1 To Nb)
For k = 1 To Nb
For i = 1 To n - 3 Step 4
j = 1 + (i - 1) \ 4
RES(j, k) = PART(TB(i, k), 1) & "-" & PART(TB(i + 1, k), 1) & " <> " & PART(TB(i + 2, k), 1) & "-" & PART(TB(i + 3, k), 1)
Next i
Next k
End With
Feuil2.Range("A2").Resize(R, Nb) = RES
MsgBox "Terminé "
End Sub
'Permet d'organiser aléatoirement les éléments du tableau TBL
Private Sub ALEAT(ByRef TBL)
Dim i As Long, j As Long
For i = 1 To n
Randomize
j = CLng((n - i) * Rnd() + i)
If i <> j Then INVERS TBL, i, j
Next i
End Sub
'Permet d'inverser les cellules i et j du tableau TBL
Private Sub INVERS(ByRef TBL, ByVal i As Long, ByVal j As Long)
Dim Tmp As String
Tmp = TBL(i, 1)
TBL(i, 1) = TBL(j, 1)
TBL(j, 1) = Tmp
End Sub
'Permet de classer les éléments du tableau TBL pour permettre de construire les équipes par partie (4 par 4)
Private Sub EQUIPES(ByRef TBL, ByVal k As Byte)
Dim i As Long, j As Long
For i = 1 To n
If k = 1 Then
TBL(i, 1) = i
Else
If j <= n - 4 And j <> 0 Then
j = j + 4
Else
j = ((i - 1) \ R) + 1
End If
TBL(i, k) = TBL(j, k - 1)
End If
Next i
End Sub |
