Fonction aléatoire

[magicglide]

Bonjour,
J'ai un petit problème à vous soumettre.
En cellule A1, j'ai un nombre, admettons 1500.
En cellules A2:A10, je souhaiterai créer aléatoirement autant de nombre (zéro compris) que de cellules (ici 9) dont la somme serait égale à A1.
Quelle serait la formule à écrire dans les cellules A2:A10 ?
Merci pour vos suggestions.

 

[JJ1]

Re : Fonction aléatoire

Bonjour,

Un essai avec un code tout simple qui tourne tant que A11 n'est pas égal à 1500.

a+

 

[ROGER2327]

Re : Fonction aléatoire

Bonjour à tous.

Une fonction personnalisée :​

Function SommeAlea(v#)
Dim i&, j&, c&, l&, s#, a#(), p

'    Application.Volatile 'Si besoin est.

    c = Application.Caller.Columns.Count
    l = Application.Caller.Rows.Count
    ReDim a(1 To l, 1 To c)
    Randomize
    For i = 1 To l: For j = 1 To c: a(i, j) = Rnd: s = s + a(i, j): Next j, i
    For i = 1 To l: For j = 1 To c: a(i, j) = a(i, j) * v / s: Next j, i
    SommeAlea = a
End Function

Mode d'emploi :

1. Sélectionner la plage de résultats souhaitée.
2. Saisir la formule

   =SommeAlea(x)

   où x est la somme visée. x peut être une référence de cellule ou un nombre explicite.
3. Valider par Ctrl Maj Entrée.

Dans l'exemple proposé :

1. Sélectionner la plage A2:A10.
2. Saisir la formule

   =SommeAlea(A1)

3. Valider par Ctrl Maj Entrée.

Voyez d'autres exemples dans le classeur joint.
​

ROGER2327
#6826

Jeudi 12 Absolu 141 (Vide - Vacuation)
3ème Sanculottide An CCXXI, 6,4912h - fête du Travail
2013-W38-4T15:34:44Z

 

[mapomme]

Re : Fonction aléatoire

Bonsoir magicglide, JJ1, ROGER2327,

J'avais interprété de manière différente:

• Les nombres sont compris entre 0 et la valeur de A1 (nombres tous positifs ou nuls)
• Les nombres sont des entiers et non des décimaux.

Je suis donc arrivé à deux macros (l'une acceptant les doublons, l'autre non).

Pour la macro refusant les doublons:

• Il faut que la valeur de A1 soit supérieure ou égale à 36.
• Pour des petites valeurs de A1 (ex: 55) l'exécution est un peu plus longue

Le principe pour accélérer l'exécution est d'éliminer pour le tirage du nombre suivant, les éléments qui, "s'ils étaient choisis", feraient dépasser la somme fixée en A1 (ex si on a tiré 5 nombres dont le total est 1498, alors seuls trois nombres sont permis pour le choix 6 qui sont 0,1,2).

Le code

Option Explicit

Sub AleaSomme()
Const nFoisMax = 1000

Dim maxi As Long, tablo
Dim i As Long, j As Long, k As Long, m As Long, S As Long
Dim res(1 To 9) As Long, elem, BorneSup As Long

  maxi = Sheets("Feuil1").Range("A1")
  Sheets("Feuil1").Range("a2").Resize(9).ClearContents
  Sheets("Feuil1").Range("d14") = "En cours..."
  For k = 1 To nFoisMax
    Randomize
    ReDim tablo(0 To maxi)
    For i = 0 To maxi: tablo(i) = i: Next i
    Erase res:  S = 0
    For i = 1 To 9
      res(i) = tablo(Int(Rnd * (UBound(tablo) + 1)))
      S = S + res(i)
      BorneSup = maxi - S + 1: m = -1
      For j = 0 To UBound(tablo)
        If tablo(j) < BorneSup Then
          m = m + 1
          tablo(m) = tablo(j)
        End If
      Next j
      If m <> -1 Then ReDim Preserve tablo(0 To m) Else Exit For
    Next i
    If i = 10 And S = maxi Then
      Sheets("Feuil1").Range("a2").Resize(9) = Application.Transpose(res)
      Sheets("Feuil1").Range("d14") = "Exécution terminée"
      Exit Sub
    End If
  Next k
  Sheets("Feuil1").Range("d14") = "Exécution terminée"
End Sub

Sub AleaSommeUnique()
Const nFoisMax = 1000000

Dim maxi As Long, tablo
Dim i As Long, j As Long, k As Long, m As Long, S As Long
Dim res(1 To 9) As Long, elem, BorneSup As Long
  Sheets("Feuil1").Range("d14") = "En cours..."
  maxi = Sheets("Feuil1").Range("A1")
  Sheets("Feuil1").Range("a2").Resize(9).ClearContents
  If maxi < 36 Then
    MsgBox "Mission impossible"
    Sheets("Feuil1").Range("d14") = "Exécution terminée"
    Exit Sub
  End If
  For k = 1 To nFoisMax
    Randomize
    DoEvents
    ReDim tablo(0 To maxi)
    For i = 0 To maxi: tablo(i) = i: Next i
    Erase res:  S = 0
    For i = 1 To 9
      elem = Int(Rnd * (UBound(tablo) + 1))
      res(i) = tablo(elem)
      tablo(elem) = maxi + 1
      S = S + res(i)
      BorneSup = maxi - S + 1: m = -1
      For j = 0 To UBound(tablo)
        If tablo(j) < BorneSup Then
          m = m + 1
          tablo(m) = tablo(j)
        End If
      Next j
      If m < 9 - i Then Exit For
      If m <> -1 Then ReDim Preserve tablo(0 To m) Else Exit For
    Next i
    If i = 10 And S = maxi Then
      Sheets("Feuil1").Range("a2").Resize(9) = Application.Transpose(res)
      Sheets("Feuil1").Range("d14") = "Exécution terminée"
      Exit Sub
    End If
  Next k
Sheets("Feuil1").Range("d14") = "Exécution terminée"
End Sub

 

[Modeste geedee]

Re : Fonction aléatoire

Bonsour®

Bonjour,
J'ai un petit problème à vous soumettre.
En cellule A1, j'ai un nombre, admettons 1500.
En cellules A2:A10, je souhaiterai créer aléatoirement autant de nombre (zéro compris) que de cellules (ici 9) dont la somme serait égale à A1.
Quelle serait la formule à écrire dans les cellules A2:A10 ?
Merci pour vos suggestions.

vous avez dit formule ?
alors sans macro

alea()
règle de proportionnalité
variable d'ajustement

 

[magicglide]

Re : Fonction aléatoire

Merci à tous pour vos réponses que je découvre à l'instant.
N'étant pas très fortiche en VB, la solution de Modeste geedee me séduit bien et répond parfaitement à mes besoins.
Encore un Grand merci et très bonne journée.

 

[ROGER2327]

Re : Fonction aléatoire

Bonjour à tous.

Le problème de notre ami semble résolu. Mais comme le problème m'a amusé, je complète ma réponse avec quelques variantes.

Notamment, pour suivre mapomme :​

(...)
J'avais interprété de manière différente:

• Les nombres sont compris entre 0 et la valeur de A1 (nombres tous positifs ou nuls)
• Les nombres sont des entiers et non des décimaux.

(...)

Voici donc une fonction pour obtenir des entiers positifs sans répétition :​

Function SommeAlea5(v&)
'La bibliothèque Microsoft Scripting Runtime doit être active.
Dim i&, j&, lMax&, cMax&, nDat&, vTmp&, Tmp&, InfTmp&, SupTmp&, a&(), s1%, s2%, Memo As New Scripting.Dictionary

    Application.Volatile 'Si besoin est.

    cMax = Application.Caller.Columns.Count
    lMax = Application.Caller.Rows.Count
    nDat = lMax * cMax
    If (nDat - 1) * nDat > 2 * v Then SommeAlea5 = "" * 1: Exit Function

    ReDim a(1 To lMax, 1 To cMax)
    Randomize
    s1 = 10
    Do
        s1 = s1 - 1
        Set Memo = Nothing
        vTmp = v
        For i = 1 To lMax
            For j = 1 To cMax
                If i * j < nDat Then
                    SupTmp = vTmp - (nDat - (i - 1) * cMax - j - 1) * (nDat - (i - 1) * cMax - j) / 2
                    InfTmp = Int((Sqr(1 + 8 * vTmp) - 3)) / 2
                    s2 = 10
                    Do
                        s2 = s2 - 1
                        Tmp = InfTmp + Int((1 + SupTmp - InfTmp) * Rnd)
                    Loop While Memo.Exists(Tmp) And s2 > 0
                    If s2 Then s1 = 10: Memo.Add Tmp, Tmp Else Exit For
                    a(i, j) = Tmp
                    vTmp = vTmp - a(i, j)
                End If
            Next
            If s2 = 0 Then Exit For
        Next
    Loop While Memo.Exists(vTmp) And s1 > 0 Or s2 = 0
    a(lMax, cMax) = vTmp
    SommeAlea5 = a
End Function

Le mode d'emploi est celui décrit dans le message #3.
Pour obtenir un résultat, il faut évidemment que v ≥ (n-1).n/2 où n est le nombre de cellules sélectionnées.​

Bonne journée.


ROGER2327
#6827

Vendredi 13 Absolu 141 (Saint Cantarel, l’illuminateur - fête Suprême Quarte)
4ème Sanculottide An CCXXI, 4,3442h - fête de l'Opinion
2013-W38-5T10:25:34Z