Générer des chiffres aléatoires

[slamos]

Bonjour,

Je recherche une formule pour générer des nombres aléatoires. Jusque là ça va.

Ces nombres doivent donner en les ajoutant un total qui sera connu.

Les nombres générés doivent être compris entre deux plages définies.

Et enfin, il faudrait définir la quantité de nombre aléatoires générés.

Exemple :

Je souhaite générer 20 nombres aléatoires compris entre les chiffres 5 et 25 pour obtenir un total de 300. Un même nombre peut-être répeté plusieurs fois.

J'espère que j'ai été claire 😛

Merci

Slamos

 

[job75]

Re : Générer des chiffres aléatoires

Bonsoir Slamos, bienvenue sur le forum,

Ci-joint le fichier avec la macro :

Sub Aleatoire()
Dim cel As Range, S As Integer
Application.ScreenUpdating = False
Randomize
1 S = 0
For Each cel In Range("A1:A20")
cel = 5 + Int(21 * Rnd)
S = S + cel
Next
If S <> 300 Then GoTo 1
Application.ScreenUpdating = True
End Sub

A+

 

[ROGER2327]

Re : Générer des chiffres aléatoires

Bonsoir à tous,

Une autre proposition dans le fichier joint.

Option Explicit

Sub somme_NSom_colonne()
Dim STab(), NNb As Long, PrintLoc As String
    NNb = 20
    PrintLoc = "$C$2"
    STab = S_NSom(NMin:=5, NMax:=25, NNb:=NNb, NSom:=300, PrintLoc:=PrintLoc) 'paramètres à adapter
    Range(PrintLoc, Range(PrintLoc).Offset(NNb - 1, 0)).Value = STab 'sortie en colonne
End Sub

Sub somme_NSom_ligne()
Dim STab(), NNb As Long, PrintLoc As String
    NNb = 20
    PrintLoc = "$C$2"
    STab = S_NSom(NMin:=5, NMax:=25, NNb:=NNb, NSom:=300, PrintLoc:=PrintLoc) 'paramètres à adapter
    Range(PrintLoc, Range(PrintLoc).Offset(0, NNb - 1)).Value = Application.Transpose(STab) 'sortie en ligne
End Sub

Private Function S_NSom(NMin As Long, NMax As Long, NNb As Long, NSom As Long, PrintLoc As String)
Dim i As Long, s As Long, x As Long
Dim STab()
    ReDim STab(1 To NNb, 1 To 1)
    Randomize
    For i = 1 To NNb
        STab(i, 1) = NMin + Int((NMax - NMin + 1) * Rnd())
        s = s + STab(i, 1)
    Next i
    s = NSom - s
    For i = 1 To Abs(s)
        x = 1 + Int(NNb * Rnd())
        STab(x, 1) = STab(x, 1) + Sgn(s)
        If STab(x, 1) < NMin Then i = i - 1: STab(x, 1) = NMin
        If STab(x, 1) > NMax Then i = i - 1: STab(x, 1) = NMax
    Next i
    S_NSom = STab
End Function

Nettement plus rapide...​

Bonne nuit!
ROGER2327

 

[soenda]

Re : Générer des chiffres aléatoires

Bonjour le forum, slamos, job75, roger2327

Puisque "pas 2 sans 3", voici ma proposition.
Elle permet aléatoirement, la sortie ou non, d'un plus gros numéro que le max des 19 autres.

Sub b()
    Dim L%, tot%, Coef As Integer
    
    Randomize (Timer)
    
    Do
        tot = 0
        Coef = 21
        
        For L = 1 To 19
        
            x = Int(Coef * Rnd() + 5)
            Cells(L, 1) = x
            
            tot = tot + x
            Coef = IIf(tot / L > 15, Coef - 1, Coef + 1)
            
        Next
        
    Loop Until (tot <= 295)
    
    Cells(L, 1) = 300 - tot
    
End Sub

A plus

 

[PMO2]

Re : Générer des chiffres aléatoires

Bonjour,

Une solution dynamique avec les codes suivants

Etape 1 : USERFORM
1) créer un UserForm (propriété (Name) UserForm1)
2) y insérer 4 TextBox avec pour propriété (Name) respectivement
TextBox1
TextBox2
TextBox3
TextBox4
3) à la gauche de ces TextBox, créer 4 Label avec pour propriétés (Name) et Caption respectivement
Label1 Nombre
Label2 Mini
Label3 Maxi
Label4 Total
4) créer 2 CommandButton avec pour propriétés (Name) et Caption respectivement
CommandButton1 OK
CommandButton2 Annuler
5) copier le code suivant dans la fenêtre de code du UserForm

Private Sub CommandButton1_Click()
Dim C As Control
Dim cpt%
For Each C In Me.Controls
  If TypeName(C) = "TextBox" Then
    If Not IsNumeric(C.Value) Then C.Value = ""
    If C.Value = "" Then
      Erase myParam
      C.SetFocus
      Exit Sub
    Else
      cpt% = cpt% + 1
      myParam(cpt%) = C.Value
    End If
  End If
Next C
Unload Me
Call Generer(myParam(1), myParam(2), myParam(3), myParam(4))
Erase myParam
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Etape 2 : MODULE STANDARD
1) créer un module standard
2) y copier le code suivant

Public myParam(1 To 4) As Long

Sub Generer(Nombre&, Mini&, Maxi&, Total&)
Dim T&()
Dim i&
Dim x&
Dim somme&
Dim R As Range
Dim C As Comment
On Error GoTo Erreur
If Maxi& > Total& Then Error 65535
If Nombre& = 0 Then Error 65534
If Nombre& * Maxi& < Total& Then Error 65533
If Nombre& * Mini& > Total& Then Error 65532
If Mini& >= Maxi& Then Error 65531
If ActiveCell.Row + Nombre& - 1 > 65536 Then Error 65530
ReDim T&(1 To Nombre&, 1 To 1)
Randomize Timer
For i& = 1 To Nombre&
  Do
    x& = Int((Maxi& * Rnd) + 1)
  Loop Until x& >= Mini&
  T&(i&, 1) = x&
  somme& = somme& + x&
Next i&
If somme& < Total& Then
  Do
    x& = Int((Nombre& * Rnd) + 1)
    If T&(x&, 1) < Maxi& Then
      T&(x&, 1) = T&(x&, 1) + 1
      somme& = somme& + 1
    End If
  Loop Until somme& = Total&
ElseIf somme& > Total& Then
  Do
    x& = Int((Nombre& * Rnd) + 1)
    If T&(x&, 1) > Mini& Then
      T&(x&, 1) = T&(x&, 1) - 1
      somme& = somme& - 1
    End If
  Loop Until somme& = Total&
End If
Set R = ActiveCell.Resize(Nombre&, 1)
R.Select
i& = MsgBox("Le résultat va s'inscrire dans la plage " & R.Address(False, False) & vbCrLf & _
    "Voulez-vous continuer ?", vbOKCancel + vbDefaultButton2)
If i& <> vbOK Then Exit Sub
R = T&
ActiveCell.Select
Set C = ActiveCell.AddComment
C.Visible = True
C.Text Text:="Nombre : " & Nombre& & Chr(10) & _
             "Mini : " & Mini& & Chr(10) & _
             "Maxi : " & Maxi& & Chr(10) & _
             "Total : " & Format(Total&, "# ### ### ###")
Exit Sub
Erreur:
Select Case Err
  Case 65535
    MsgBox "Le maxi (" & Maxi& & ") est supérieur au total (" & Total& & ")."
  Case 65534
    MsgBox "Le nombre de nombres à générer est égal à zéro (0)."
  Case 65533
    MsgBox "Le nombre de nombres à générer (" & Nombre& & ") multiplié par le maxi (" & Maxi& & ") est inférieur au total (" & Total& & ")."
  Case 65532
    MsgBox "Le nombre de nombres à générer (" & Nombre& & ") multiplié par le mini (" & Mini& & ") est supérieur au total (" & Total& & ")."
  Case 65531
    MsgBox "Anomalie entre mini (" & Mini& & ") et maxi (" & Maxi& & ")."
  Case 65530
    MsgBox "Dépassement du nombre de lignes autorisé par Excel."
  Case Else
    MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
End Select
End Sub

Sub GenererNbAleatoires()
UserForm1.Show
End Sub

Etape 3 : FONCTIONNEMENT
1) dans une feuille vierge sélectionner une cellule (par exemple D1)
2) lancer la macro GenererNbAleatoires
3) dans le UserForm qui s'affiche, taper les Nombre, Mini, Maxi, Total (ex : 20, 5, 25, 300 ou 50000, 100, 300 , 12874000)
4) cliquer sur OK et le résultat s'affiche en lignes à partir de D1.

Cordialerment.

PMO
Patrick Morange

 

[slamos]

Re : Générer des chiffres aléatoires

Merci à tous, j'ai trouvé ce que je cherchais grace à vous.

Encore merci, c'est vraiment super

Mikael