LOUPATOCHE
XLDnaute Nouveau
Je souhaiterai faire des combinaisons de 5 nombres parmis une liste de chiffre de 1 à 90 avec comme contrainte pas de chiffres de la même dizaine dans la combinaison.
merci de votre aide
merci de votre aide
Je souhaiterai faire des combinaisons de 5 nombres parmis une liste de chiffre de 1 à 90 avec comme contrainte pas de chiffres de la même dizaine dans la combinaison.
merci de votre aide
Sub test()
Dim n As Byte, x As New Collection
Randomize
Do While x.Count < 5
On Error Resume Next
n = Int(10 * Rnd)
x.Add n, CStr(n)
Loop
On Error GoTo 0
For n = 1 To 5
Cells(1, n).Value = IIf(x(n) <> 0, x(n) & Int(10 * Rnd), x(n) & Int(9 * Rnd) + 1)
If Cells(1, n).Value > 90 Then Cells(1, n).Value = 90
Next n
End Sub
Sub test()
Dim n As Byte, x As New Collection
Randomize
Do While x.Count < 5
On Error Resume Next
n = Int(90 * Rnd) + 1
x.Add Int(n / 10), CStr(Int(n / 10))
If Err.Number = 0 Then Cells(1, x.Count).Value = n
Loop
On Error GoTo 0
End Sub
Option Explicit
Sub test()
Dim t As Single, n As Byte, x As New Collection, i As Byte, x2 As New Collection
Range("A1:E18").ClearContents
Application.ScreenUpdating = False
debut:
t = Timer
Set x = Nothing
Set x2 = Nothing
Randomize
For i = 1 To 18
Do While x.Count < 5
If Timer > t + 0.2 Then GoTo debut
On Error Resume Next
n = Int(90 * Rnd) + 1
x.Add Int(n / 10), CStr(Int(n / 10))
If Err.Number = 0 Then
x2.Add n, CStr(n)
If Err.Number = 0 Then
Cells(i, x.Count).Value = n
Else
x.Remove x.Count
End If
End If
Loop
On Error GoTo 0
Set x = Nothing
Next i
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub test()
Dim t As Single, n As Byte, x As New Collection, i As Byte, x2 As New Collection
Range("A1:E18").ClearContents
Application.ScreenUpdating = False
debut:
t = Timer
Set x = Nothing
Set x2 = Nothing
Randomize
For i = 1 To 18
Do While x.Count < 5
If Timer > t + 0.2 Then GoTo debut
On Error Resume Next
n = Int(90 * Rnd) + 1
x.Add Int(n / 10), CStr(Int(n / 10))
If Err.Number = 0 Then
x2.Add n, CStr(n)
If Err.Number = 0 Then
Cells(i, x.Count).Value = n
Else
x.Remove x.Count
End If
End If
Loop
On Error GoTo 0
Set x = Nothing
Next i
For i = 1 To 18
Range(Cells(i, 1), Cells(i, 5)).Sort Key1:=Cells(i, 1), Order1:=xlAscending, _
Orientation:=xlLeftToRight
Next i
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub test()
Dim t As Single, n As Byte, x As New Collection, i As Byte, x2 As New Collection, z As Byte
Range("A1:E18").ClearContents
Application.ScreenUpdating = False
debut:
t = Timer
Set x = Nothing
Set x2 = Nothing
Randomize
For i = 1 To 18
Do While x.Count < 5
If Timer > t + 0.2 Then GoTo debut
On Error Resume Next
n = Int(90 * Rnd) + 1
z = IIf(Int(n / 10) = 9, 8, Int(n / 10))
x.Add z, CStr(z)
If Err.Number = 0 Then
x2.Add n, CStr(n)
If Err.Number = 0 Then
Cells(i, x.Count).Value = n
Else
x.Remove x.Count
End If
End If
Loop
On Error GoTo 0
Set x = Nothing
Next i
For i = 1 To 18
Range(Cells(i, 1), Cells(i, 5)).Sort Key1:=Cells(i, 1), Order1:=xlAscending, _
Orientation:=xlLeftToRight
Next i
Application.ScreenUpdating = True
End Sub