Sub Macro2()
Columns("U:X").ClearContents
Range("M3:P7").ClearContents
'Application.ScreenUpdating = False
For i = 1 To 1000
For j = 21 To 24
RECOM:
Randomize
ALEA = CInt(Int((18 * Rnd()) + 1))
If ALEA = 5 Or ALEA = 10 Or ALEA = 13 Or ALEA = 17 Then GoTo RECOM
Cells(i, j) = ALEA
Next j
For k = 22 To 24
prems = Cells(i, k - 1)
doublon = Application.Match(prems, Range(Cells(i, k), Cells(i, 24)), 0)
'doublon = Application.Match(prems, Range("U" & i & ":X" & i), 0)
If IsError(doublon) = False Then
i = i - 1 'Range(Cells(i, k), Cells(i, 24)).Delete
GoTo saut
End If
Next k
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
"U" & i & ":X" & i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("U" & i & ":X" & i)
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
saut:
Next i
Columns("U:X").Select
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("U1:U1000" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("V1:V1000" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("W1:W1000" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("X1:X1000" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("U1:X1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
borns = 1
borni = 1
cgt:
Do While Cells(borns, 24) <> ""
continu:
If Cells(borni, 23) = Cells(borns + 1, 23) Then
borni = borni + 1
GoTo continu
Else
For elim = borns To borni - 2
If Cells(elim, 24) = Cells(elim + 1, 24) Then
Range(Cells(elim + 1, 21), Cells(elim + 1, 24)).Delete Shift:=xlUp
elim = elim - 1
borni = borni - 1
End If
Next elim
End If
borns = borni + 2
borni = borns
GoTo cgt
Loop
End Sub
Sub TIRAGE()
Range("M3:P7").ClearContents
fin = Range("U1000").End(xlUp).Row
For parach = 3 To 7
'Randomize
ALEB = CInt(Int((fin * Rnd()) + 1))
Range(Cells(ALEB, 21), Cells(ALEB, 24)).Copy
Range(Cells(parach, 13), Cells(parach, 16)).PasteSpecial
Next parach
'Application.ScreenUpdating = True
End Sub