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
| Option Explicit
Sub Traitement()
Dim n As Long
Dim m As Byte
Dim Tb, Tmp
Application.ScreenUpdating = False
Initialisation Tb
n = UBound(Tb, 1)
For m = 1 To 4
Aleatoire Tb
Tmp = Resultat(Tb, m)
Worksheets("Tabl").Cells(4, 5 * m - 2).Resize(n, 3) = Tmp
Next m
End Sub
Private Sub Initialisation(ByRef Tb)
Dim LastLig As Long
Application.ScreenUpdating = False
With Worksheets("Données")
LastLig = .Cells(.Rows.Count, 2).End(xlUp).Row
Tb = .Range("A4:F" & LastLig)
End With
End Sub
Private Sub Aleatoire(ByRef Tb)
Dim n As Long, i As Long, j As Long
Dim m As Byte, p As Byte
Dim Temp
n = UBound(Tb, 1)
p = UBound(Tb, 2)
For i = 1 To n
Randomize
j = CLng(((n - i) * Rnd) + i)
If i <> j Then
For m = 1 To p
Temp = Tb(i, m)
Tb(i, m) = Tb(j, m)
Tb(j, m) = Temp
Next m
End If
Next i
End Sub
'k=i: Partie i
Private Function Resultat(ByVal Tb, ByVal k As Byte)
Dim n As Long, i As Long
Dim Res()
n = UBound(Tb, 1)
ReDim Res(1 To n, 1 To 3)
For i = 1 To n
Res(i, 1) = Tb(i, 1)
Res(i, 2) = Tb(i, 2)
Res(i, 3) = Tb(i, k + 2)
Next i
Resultat = Res
End Function |
Partager