Demande d'aide : Répartition aléatoire

[Xochimiqui]

Bonjour, j'ai tenté de rechercher si mon problème a déjà été soumis mais je n'ai pas trouvé ma réponse... après j'avoue que je n'ai pas toujours tout compris... 🙁
Bref, désolé s'il y a redite.

Je cherche une fonction qui me permette de répartir un total de 100 dans 6 cellules selon des probabilités déterminées aléatoirement.

Exemple :
Cellule A : 5 à 15
Cellule B : 10 à 25
Cellule C : 0
Cellule D : 10 à 20
Cellule E : 30 à 40
Cellule F : 0

La fonction aléa.entre.bornes me permet bien de générer un chiffre pour chaque cellule, mais pas de m'assurer que le total des 6 soit égal à 100.
Comment puis-je procéder ?
Merci de votre pitié...

 

[FROLLINDE]

Re : Demande d'aide : Répartition aléatoire

Bonsoir chimiqui, Hello Forum..

Une proposition est de ramener tes valeurs Alléatoires en base 100...

Voir fichier joint..

 

[job75]

Re : Demande d'aide : Répartition aléatoire

Bonsoir Xochimiqui, bienvenue sur XLD

Placez cette macro où vous voulez dans VBA (Alt+F11) et exécutez-la :

Sub Tirages100()
Dim r As Range, s&, t()
Set r = [A1:F1]
s = 100
ReDim t(1 To 6)
Randomize
t(3) = 0: t(6) = 0
Do
  t(1) = Int(5 + 11 * Rnd)
  t(2) = Int(10 + 16 * Rnd)
  t(4) = Int(10 + 11 * Rnd)
  t(5) = Int(30 + 11 * Rnd)
Loop Until Application.Sum(t) = s
r = t
End Sub

Edit : bonsoir FROLLINDE.

A+

 

[job75]

Re : Demande d'aide : Répartition aléatoire

Re,

Vous remarquerez que pour s = 100, égal à la somme des maxima, il n'y a qu'une solution.

Idem pour s = 55, égal à la somme des minima.

Plusieurs solutions si 55 < s < 100.

Pas de solution pour s < 55 ou s > 100 : la macro boucle sans fin...

A+

 

[ROGER2327]

Re : Demande d'aide : Répartition aléatoire

Bonsoir à tous.

Une solution par formules.​

Bonne soirée.


ℝOGER2327
#7724

Dimanche 1[SUP]er[/SUP] Gueules 142 (Dépucelage de Mère Ubu - fête Suprême Tierce)
7 Pluviôse An CCXXIII, 7,5535h - amadouvier
2015-W05-1T18:07:42Z

 

[job75]

Re : Demande d'aide : Répartition aléatoire

Bonsoir Roger,

Retour de soirée, j'apprécie bien votre solution et sa présentation.

Je me permets juste une petite simplification.

En effet vous utilisez 3 formules sur la plage D8:I8.

On peut n'en utiliser qu'une puisque les cellules C8 J3 J4 ne contiennent pas de nombres :

En D8 :

=ALEA.ENTRE.BORNES(MAX($K4-SOMME($C8:C8)-SOMME(E4:$J4);D3);MIN($K4-SOMME($C8:C8)-SOMME(E3:$J3);D4))

Fichier joint.

Bonne nuit.

 

[ROGER2327]

Re : Demande d'aide : Répartition aléatoire

Suite...

Une version enrichie d'un onglet utilisant une fonction personnalisée (sans Do ... Loop incontrôlé !!!) :​

Function partage(n#, inf As Range, sup As Range, Optional typ As Boolean)
Application.Volatile
Dim c&, i&, a#, b#, t#, v As Variant, f#()
    v = ""
    c = inf.Count
    If c = sup.Count Then
        ReDim f(1 To c + 1, 3)
        For i = c To 1 Step -1: f(i, 0) = inf(i): f(i, 1) = sup(i): f(i, 2) = f(i + 1, 2) + f(i + 1, 0): f(i, 3) = f(i + 1, 3) + f(i + 1, 1): Next
        If f(1, 2) + f(1, 0) <= n And n <= f(1, 3) + f(1, 1) Then
            ReDim v(1 To c)
            Randomize
            For i = 1 To c
                n = n - t
                If n - f(i, 3) > f(i, 0) Then a = n - f(i, 3) Else a = f(i, 0)
                If n - f(i, 2) < f(i, 1) Then b = n - f(i, 2) Else b = f(i, 1)
                If typ Then t = a + Int((b - a + 1) * Rnd) Else t = a + (b - a) * Rnd
                v(i) = t
            Next
        End If
    End If
    partage = v
End Function

ℝOGER2327
#7725

Lundi 2 Gueules 142 (Saint Sigisbée, eunuque - fête Suprême Quarte)
8 Pluviôse An CCXXIII, 0,8188h - mézéréon
2015-W05-2T01:57:54Z

 

[Xochimiqui]

Re : Demande d'aide : Répartition aléatoire

Merci à tous, je vais éplucher tout ça !

Xo.

 

[Xochimiqui]

Re : Demande d'aide : Répartition aléatoire

Roger et Job il y a quelque chose que je ne comprends pas dans vos formules : le tirage aléatoire donne systématiquement la valeur max...

 

[Xochimiqui]

Re : Demande d'aide : Répartition aléatoire

Bonjour, merci c'est effectivement ce que je cherchais, seul souci au final les valeurs ramenées en base 100 peuvent dépasser le max définit par les bornes. Existe-t-il une astuce pour remédier à cela ?

 

[Xochimiqui]

Re : Demande d'aide : Répartition aléatoire

"Une proposition est de ramener tes valeurs Alléatoires en base 100..."

Bonjour, merci c'est effectivement ce que je cherchais, seul souci au final les valeurs ramenées en base 100 peuvent dépasser le max définit par les bornes. Existe-t-il une astuce pour remédier à cela ?

 

[job75]

Re : Demande d'aide : Répartition aléatoire

Bonjour Xochimiqui, le forum,

Roger et Job il y a quelque chose que je ne comprends pas dans vos formules : le tirage aléatoire donne systématiquement la valeur max...

Vous remarquerez que pour s = 100, égal à la somme des maxima, il n'y a qu'une solution.

Idem pour s = 55, égal à la somme des minima.

A+

 

[job75]

Re : Demande d'aide : Répartition aléatoire

Re,

Toujours avec le fichier de Roger, une autre solution par fonction VBA :

Function Tirages(mini As Range, maxi As Range, somme&)
'mini et maxi sont des vecteurs de même dimension
Application.Volatile
On Error Resume Next
If somme < Application.Sum(mini) Or somme > Application.Sum(maxi) _
  Then Tirages = "#": Exit Function
Dim t, i&
ReDim t(1 To mini.Count)
Randomize
Do
  For i = 1 To UBound(t)
    t(i) = Int(mini(i) + (maxi(i) - mini(i) + 1) * Rnd)
  Next
Loop Until Application.Sum(t) = somme
Tirages = t 'vecteur ligne
End Function

Elle est utilisée matriciellement sur toute la plage D8:I8.

A+