combinaison à 5 chiffres avec exclusion

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
 

Pierrot93

XLDnaute Barbatruc
Re : combinaison à 5 chiffres avec exclusion

Bonjour Loupatoche, Astralon, Gilbert

une autre solution, renvoie une combinaison dans les cellules A1 E1 :

Code:
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

bon après midi
@+

Edition : code modifié, mais pas top, le 90 à beaucoup plus de probabilités
 
Dernière édition:

Pierrot93

XLDnaute Barbatruc
Re : combinaison à 5 chiffres avec exclusion

Re

dernière version un peu plus optimisée, enfin je crois....

Code:
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

@+
 

LOUPATOCHE

XLDnaute Nouveau
Re : combinaison à 5 chiffres avec exclusion

vous êtes super !!!

pas mal du tout

maintenant, si je puis me permettre je voudrais faire 15 combinaisons de 5 chiffres de 1 à 90 en les utilisants tous est-ce faisable ? toujours avec comme contrainte pas deux chiffres de la même dizaine dans une combinaison


merci à tous
 

Pierrot93

XLDnaute Barbatruc
Re : combinaison à 5 chiffres avec exclusion

Bonjour Loupatoche

qu'entends tu par les utiliser tous, parce que 15 combinaisons multipliées par 5, cela doit donner 75 numéros utilisés, si je ne me trompe, on n'arrive donc pas à 90...

@+
 

Pierrot93

XLDnaute Barbatruc
Re : combinaison à 5 chiffres avec exclusion

Bonjour Loupatoche

regarde le code modifié ci dessous, devrait correspondre à la demande :

Code:
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

bonne journée
@+
 

Pierrot93

XLDnaute Barbatruc
Re : combinaison à 5 chiffres avec exclusion

Bonjour Loupatoche

regarde le code ci dessous, j'ai rajouté un "sort" en fin de procédure.

Code:
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

bonne journée
@+
 

Pierrot93

XLDnaute Barbatruc
Re : combinaison à 5 chiffres avec exclusion

Re

un petit règlage... à tester...

Code:
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

@+
 

Discussions similaires

  • Question
Microsoft 365 Excel365
Réponses
2
Affichages
256
Réponses
22
Affichages
804

Statistiques des forums

Discussions
312 770
Messages
2 091 944
Membres
105 118
dernier inscrit
XDL84