Conditions pour alea

[bapi]

Bonjour, j'ai un colonne de chiffres de alea entre bornes de 1 a 13, mais je cherche a trouver un moyen de ne pas avoir plus de 6 fois le meme nombre. j'espere que vous pourrez m'aidez
merci d'avance

 

[mapomme]

Re : Conditions pour alea

re bonjour,

Voici un exemple pour le tirage:


a) la fréquence est la même pour tous les nombres tirés si le nombre de valeurs tirées au sort est un multiple du nombre de choix possibles (pour votre exemple 78=6*13)
b) si le nombre de valeurs à tirer n'est pas un multiple du nombre de choix possibles, alors les valeurs au délà du dernier multiple du nombre de choix peuvent être tirées selon deux méthodes:

1- ces valeurs sont choisie dans l'ordre des possibilitée de choix (pour votre exemple 1 puis 2 puis 3...)​

2- ces valeurs sont tirées au sort parmi les possibilités de choix (pour votre exemple au hasard entre 1 et 13)​

Dans le fichier joint, vous saisissez en:
H3 : la borne inf des nombres à tirer (pour votre exemple 1)
H4 : la borne inf des nombres à tirer (pour votre exemple 13)
H5: le nombre de valeurs à tirer (pour votre exemple 78)

Le bouton 'Tirage à la suite' coorespont à la méthode 1
Le bouton 'Tirage pas à la suite' correspont à la méthode 2

Le tableau de droite montre les statitisques d'apparition des nombres.
nb: si on veut tirer des valeurs négatives, la fonction 'Tirage_a_la_Suite' sera à modifier légèrement, en translatant les bornes en début de fonction pour avoir des bornespositives puis en faisant la translation opposée à la fin sur le tableau résultat.

Sub Test_a_la_suite()
Dim MonTirage, i, Nval
Nval = [H5]
Range("A2:A1000").ClearContents
MonTirage = Tirage_a_la_Suite([H3], [H4], [H5], True)
For i = 1 To Nval
    ActiveSheet.Range("A2").Offset(i - 1, 0).Value = MonTirage(i)
Next i
End Sub

Sub Test_PAS_a_la_suite()
Dim MonTirage, i, Nval
Nval = [H5]
Range("A2:A1000").ClearContents
MonTirage = Tirage_a_la_Suite([H3], [H4], [H5], False)
For i = 1 To Nval
    ActiveSheet.Range("A2").Offset(i - 1, 0).Value = MonTirage(i)
Next i
End Sub

Function Tirage_a_la_Suite(Inf As Long, Sup As Long, Nvaleurs, AlaSUITE As Boolean) As Variant
' Tirage de Nvaleurs entre Inf et Sup
' si AlaSUITE est FAUX
' les dernières valeurs au delà du plus grand multiple de (Sup-Inf+1)
' sont tirées au hasard entre Inf et Sup mais pas deux fois la même valeur
' si AlaSUITE est VRAI
' les dernières valeurs au delà du plus grand multiple de (Sup-Inf+1)
' sont les valeurs Inf, Inf+1, Inf+2...

Dim Valeur, i, k, Temp

    ReDim T(1 To Nvaleurs)
    Valeur = Inf
    For i = 1 To (Sup - Inf + 1) * (Nvaleurs \ (Sup - Inf + 1))
        T(i) = Valeur
        Valeur = Valeur + 1
        If Valeur > Sup Then Valeur = Inf
    Next i
    
    If AlaSUITE = True Then
        For i = 1 + (Sup - Inf + 1) * (Nvaleurs \ (Sup - Inf + 1)) To Nvaleurs
            T(i) = Valeur
            Valeur = Valeur + 1
            If Valeur > Sup Then Valeur = Inf
        Next i
    Else
        'tirage de (Sup - Inf + 1) valeurs
        ReDim n(1 To (Sup - Inf + 1))
        For i = Inf To Sup
            n(i) = i
        Next i
        For i = 1 To (Sup - Inf + 1)
'            k = Application.WorksheetFunction.RandBetween(i, (Sup - Inf + 1))
            k = Int(Rnd * (Sup - Inf + 1)) + Inf
            Temp = n(i): n(i) = n(k): n(k) = Temp
        Next i
        'On copie les valeurs au delà du multiple de 13 dans le tableau T pour le compléter
        k = 0
        For i = 1 + (Sup - Inf + 1) * (Nvaleurs \ (Sup - Inf + 1)) To Nvaleurs
            k = k + 1
            T(i) = n(k)
        Next i
    End If
    
    'on secoue le tout !
    For i = 1 To Nvaleurs
'        k = Application.WorksheetFunction.RandBetween(i, Nvaleurs)
        k = Int(Rnd * (Nvaleurs - i + 1)) + i
        Temp = T(i): T(i) = T(k): T(k) = Temp
    Next i
    
    Tirage_a_la_Suite = T
End Function