Microsoft 365 Code VBA pour générer plusieurs valeurs sur une colonne avec une somme bien précise

Frangel165

XLDnaute Nouveau
Bonjour,

Besoin d'aide sur les codes VBA parce que je m'y connais pas du tout (j'apprends...). Alors serait-il possible d'avoir un code VBA avec une commande qui permet de générer dans une colonne des chiffres aléatoirement variant par exemple entre 0.25 et 0.35 et dont la somme ferait exactement 180? En d'autres mots, je souhaiterai en activant la commande (que je nommerai 180) que j'ai automatiquement des chiffres qui varient entre 0.25 et 0.35 qui se génèrent aléatoirement dans une colonne (colonne E dans le fichier en pièce jointe) et que cette somme fasse 180.
Je ne sais pas si j'ai été clair, je vous mets en PJ un fichier pour exemple dans lequel j'ai tapé manuellement les chiffres pour que vous ayez une idée. Merci d'avance les ami(e)s.
 

Fichiers joints

jmfmarques

XLDnaute Accro
Bonjour
générer dans une colonne des chiffres aléatoirement variant par exemple entre 0.25 et 0.35 et dont la somme ferait exactement 180
La seconde proposition de cette phrase est antinomique avec la première.
Un aléa ne se "construit" par pour répondre à un but. Un alea et par définition un aléa. Et la somme de nombres aléatoires est celle résultant de nombres aléatoires (qui n'en seraient plus si "choisis de sorte à ..."
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir à tous,

Une autre version avec une Sub() avec paramètres :
AleaAsommeFixe(Debut As Range, ByVal BorneInf, ByVal BorneSup, ByVal Somme)
le code doit s'adapter aux nombres de décimales des bornes. Les bornes entières sont possibles.

Exemple d'utilisation:
VB:
Sub test1()
   AleaAsommeFixe Range("e7"), 0.25, 0.35, 180
End Sub
nota : corrigé une coquille suite à un copier / coller. Prendre la version v1a

Le code est dans module1:
VB:
Sub test1()
   AleaAsommeFixe Range("e7"), 0.25, 0.35, 180
End Sub

Sub test2()
   AleaAsommeFixe Range("e7"), 25, 40, 5000
End Sub

Sub test3()
   ' Aboutit à un échec car 75.1258 ne peut pas être la somme
   ' de nombres à trois chiffres après la virgule
   ' si on ôte le 8 à la somme à atteindre, alors ça fonctionne
   AleaAsommeFixe Range("e7"), 0.255, 0.359, 75.1258
End Sub


Sub AleaAsommeFixe(Debut As Range, ByVal BorneInf, ByVal BorneSup, ByVal Somme)

' Debut => cellule à partir de laquelle on affiche les résultats
' BorneInf => une des bornes des nombres à utiliser
' BorneSup => l'autre borne des nombres à utiliser
' Somme => la somme à trouver
' les trois derniers paramètres peuvent être des cellules

Const limite = 500000      'au cas où
Dim x, y, coef, max&, aux, tot&, i&, decim&, N&, diff&, k&, nfois&

   With Debut.Parent
      .Range(.Cells(Debut.Row, Debut.Column), .Cells(.Rows.Count, Debut.Column)).Clear
   End With
   If BorneSup < BorneInf Then aux = BorneSup: BorneSup = BorneInf: BorneInf = aux
   decim = Len(Mid(BorneInf, Len(Int(BorneInf)) + 2, 99))
   x = Len(Mid(BorneSup, Len(Int(BorneSup)) + 2, 99))
   If x > decim Then decim = x
   coef = 10 ^ decim
   BorneInf = Int(BorneInf * coef)
   BorneSup = Int(BorneSup * coef)
   Somme = Somme * coef
   max = 1 + Int(Somme / BorneInf)
   ReDim t(1 To max, 1 To 1)
   Randomize
   For i = 1 To UBound(t)
      t(i, 1) = Int((BorneSup - BorneInf + 1) * Rnd + BorneInf)
      tot = tot + t(i, 1)
      If tot >= Somme Then Exit For
   Next
   N = i
   Do While tot <> Somme
      nfois = nfois + 1
      If nfois > limite Then
         MsgBox "Echec de la recherche.", vbCritical
         Exit Sub
      End If
      k = 1 + Int(Rnd * N)
      If t(k, 1) > BorneInf Then t(k, 1) = t(k, 1) - 1: tot = tot - 1
   Loop
   For i = 1 To N: t(i, 1) = Round(t(i, 1) / coef, decim): Next
   With Debut.Parent
      .Cells(Debut.Row, Debut.Column).Resize(N) = t
   End With
End Sub
 

Fichiers joints

Dernière édition:

Frangel165

XLDnaute Nouveau
Bonjour Frangel
A tester
Edit : version avec 180 exact
Bonjour PierreJean,
Encore une p'tite demande. Je souhaiterai dans une autre colonne (E) avoir plus ou moins le même code (Je sais maintenant le faire grâce à vous :) ) mais que le dernier chiffre de cette colonne (E) soit sur la même ligne que la colonne d'à coté (F). En gros je voudrai activer le première macro (ça c'est bon), activer une 2eme macro pour générer d'autres chiffres dans une autre colonne et que les derniers chiffres des 2 colonnes soit sur la même ligne. Je vous remercie d'avance
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Frangel :),
Bonjour @pierrejean ;), @jmfmarques :),
En gros je voudrai activer le première macro (ça c'est bon), activer une 2eme macro pour générer d'autres chiffres dans une autre colonne et que les derniers chiffres des 2 colonnes soit sur la même ligne.
Malgré le fait que @Frangel165 m'ignore superbement (ainsi que les règles de base de la politesse envers les répondeurs), voici une adaptation basée sur une légère modification de ma précédente procédure (pour ce que j'en ai compris). On peut aisément l'étendre à plus de deux colonnes. Voir fichier v2 joint.

La procédure AleaAsommeFixe (...) comprend un 4ème paramètre qui, en sortie de procédure, retourne le nombre d'élément qui a été nécéssaire pour constituer la somme.

VB:
Sub test1()
Const Limite = 1000
Dim nbNombre1 As Long, nbNombre2 As Long, Lim As Long
   Application.ScreenUpdating = False
   AleaAsommeFixe Range("e7"), 0.25, 0.35, 180, nbNombre1
   Do While Lim <= Limite
      Lim = Lim + 1
      AleaAsommeFixe Range("F7"), 0.25, 0.35, 180, nbNombre2
      If nbNombre2 = nbNombre1 Then Exit Do
      DoEvents
   Loop
   If Lim > Limite Then MsgBox "Pas de solution trouvée, réessayez votre chance svp.", vbCritical
   Application.ScreenUpdating = True
   MsgBox "Solution trouvée: " & vbLf & vbLf & nbNombre2 & " nombres " & _
            vbLf & "pour une somme de " & Application.Sum(Range("e7").Resize(nbNombre2)), vbInformation
End Sub

Sub AleaAsommeFixe(Debut As Range, ByVal BorneInf, ByVal BorneSup, ByVal Somme, ByRef nbRetour As Long)

' Debut => cellule à partir de laquelle on affiche les résultats
' BorneInf => une des bornes des nombres à utiliser
' BorneSup => l'autre borne des nombres à utiliser
' Somme => la somme à trouver
' les trois derniers paramètres peuvent être des cellules

Const Limite = 500000      'au cas où
Dim x, y, coef, max&, aux, tot&, i&, decim&, N&, diff&, k&, nfois&

   With Debut.Parent
      .Range(.Cells(Debut.Row, Debut.Column), .Cells(.Rows.Count, Debut.Column)).Clear
   End With
   If BorneSup < BorneInf Then aux = BorneSup: BorneSup = BorneInf: BorneInf = aux
   decim = Len(Mid(BorneInf, Len(Int(BorneInf)) + 2, 99))
   x = Len(Mid(BorneSup, Len(Int(BorneSup)) + 2, 99))
   If x > decim Then decim = x
   coef = 10 ^ decim
   BorneInf = Int(BorneInf * coef)
   BorneSup = Int(BorneSup * coef)
   Somme = Somme * coef
   max = 1 + Int(Somme / BorneInf)
   ReDim t(1 To max, 1 To 1)
   Randomize
   For i = 1 To UBound(t)
      t(i, 1) = Int((BorneSup - BorneInf + 1) * Rnd + BorneInf)
      tot = tot + t(i, 1)
      If tot >= Somme Then Exit For
   Next
   N = i
   Do While tot <> Somme
      nfois = nfois + 1
      If nfois > Limite Then
         MsgBox "Echec de la recherche.", vbCritical
         Exit Sub
      End If
      k = 1 + Int(Rnd * N)
      If t(k, 1) > BorneInf Then t(k, 1) = t(k, 1) - 1: tot = tot - 1
   Loop
   For i = 1 To N: t(i, 1) = Round(t(i, 1) / coef, decim): Next
   With Debut.Parent
      .Cells(Debut.Row, Debut.Column).Resize(N) = t
   End With
   nbRetour = N
End Sub
nota : en reprenant un peu plus le code, on pourrait être beaucoup plus efficace.
 

Fichiers joints

Dernière édition:

Frangel165

XLDnaute Nouveau
Bonjour @Frangel :),
Bonjour @pierrejean ;),


Malgré le fait que @Frangel165 m'ignore superbement (ainsi que les règles de base de la politesse envers les répondeurs), voici une adaptation pour ce que j'en ai compris basée sur une légère modification de ma précédente procédure.
Bonjour Mapomme,

Merci pour votre réponse si rapide ;)
J'ai vu votre intervention sur mon premier post ce matin et je peux vous s'assurer que cela m'a été utile, bien que je ne vous l'ai pas fait savoir (ce que je devais faire d'ailleurs). C'est vrai que j'aurai du vous répondre (cela vous appris du temps certainement) mais loin de moi l'envie de vous ignorer.
Encore merci ;)
Pour le nouveau fichier je viens de l'ouvrir, mais je souhaitais avoir 2 commandes distinctes pour les 2 paramètres. Une colonne volume (total des nombres aléatoires 180) avec une commande (c'est déjà fait) et une autre colonne pression dans le même principe que la première commande avec des valeurs qui varient aléatoirement entre 5 et 15, sauf que pour cette dernière je veux que sa dernière valeur soit sur la même ligne que la colonne volume.
Merci d'avance
 

Frangel165

XLDnaute Nouveau
@mapomme, j'ai oublié de préciser que le but rechercher sur la 2eme colonne n'est pas d'avoir une somme précise, juste générer aléatoirement des chiffres qui varient entre 5 - 15 et que la dernier chiffre de cette colonne soit sur la meme que la 1ere. Je ne sais pas si c'est clait :) :)
 

mapomme

XLDnaute Barbatruc
Supporter XLD
le but rechercher sur la 2eme colonne n'est pas d'avoir une somme précise, juste générer aléatoirement des chiffres qui varient entre 5 - 15 et que la dernier chiffre de cette colonne soit sur la meme que la 1ere. Je ne sais pas si c'est clait
Donc si en colonne E on a trouvé une somme de 180 pour N nombres, on désire pour la colonne F également N nombres (entre 5 et 15) mais la somme en colonne sera quelconque .
Est-ce bien cela ?

Le début de la colonne F est-il le même que celui de la colonne E ?
 

Frangel165

XLDnaute Nouveau
Donc si en colonne E on a trouvé une somme de 180 pour N nombres, on désire pour la colonne F également N nombres (entre 5 et 15) mais la somme en colonne sera quelconque .
Est-ce bien cela ?

Le début de la colonne F est-il le même que celui de la colonne E ?
@mapomme oui c'est exactement ça. En colonne E c'est le volume = 180 qui est recherché pour N nombres. En colonne F c'est juste générer des valeurs aléatoires entre 5 - 10 sans tenir compte de la somme. Pour une valeur de volume de la colonne E , je souhaite avoir sa valeur de pression sur la colonne F.
Le début de la colonne F est le même que celui de la E.
L'idée pour moi à la fin c'est de faire un graphe Volume/Pression avec ces données.
 

jmfmarques

XLDnaute Accro
Re (et un lut à mapomme)
L'idée pour moi à la fin c'est de faire un graphe Volume/Pression avec ces données.
Voilà une phrase qui me laisse perplexe, un "graphe" de l'espèce n'ayant aucun sens, dès lors qu'établi sur la base de valeurs aléatoires.
Tout ceci n'aurait-il finalement pour seul vrai but que celui de se doter de données devant servir de base d'application d'un outil ? Si oui, ce serait quelque peu abusif.
Je VEUX écarter une hypothèse qui me gênerait beaucoup plus encore : celle de "ballons d'essai" pour "voir" le résultat (forcément aléatoire) final et estimer que "tel graphe" est plus intéressant que "tel autre graphe".
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re, [USER=288478]@Frangel165[/USER :) ,

Voici la version v3 complétée.
VB:
Sub Test1()
Const borne1 = 0.25, borne2 = 0.35, Somme = 180
Const limite1 = 5, limite2 = 15
Dim nbNombre As Long
   Application.ScreenUpdating = False
   Range("e7").Resize(Rows.Count - Range("e7").Row, 2).Clear
   AleaAsommeFixe Range("e7"), borne1, borne2, Somme, nbNombre
   With Range("f7").Resize(nbNombre)
      .Formula = Replace(Replace("=RANDBETWEEN(x,y)", "x", limite1), "y", limite2)
      .Value = .Value
   End With
   MsgBox "Solution trouvée: " & vbLf & vbLf & nbNombre & " nombres " & _
         vbLf & "pour une somme de " & Application.Sum(Range("e7").Resize(nbNombre)), vbInformation
End Sub
nota : préférez la v3a.
 

Fichiers joints

Dernière édition:

Frangel165

XLDnaute Nouveau
Re, [USER=288478]@Frangel165[/USER :) ,

Voici la version v3 complétée.
VB:
Sub Test1()
Const borne1 = 0.25, borne2 = 0.35, Somme = 180
Const limite1 = 5, limite2 = 15
Dim nbNombre As Long
   Application.ScreenUpdating = False
   Range("e7").Resize(Rows.Count - Range("e7").Row, 2).Clear
   AleaAsommeFixe Range("e7"), borne1, borne2, Somme, nbNombre
   With Range("f7").Resize(nbNombre)
      .Formula = Replace(Replace("=RANDBETWEEN(x,y)", "x", limite1), "y", limite2)
      .Value = .Value
   End With
   MsgBox "Solution trouvée: " & vbLf & vbLf & nbNombre & " nombres " & _
         vbLf & "pour une somme de " & Application.Sum(Range("e7").Resize(nbNombre)), vbInformation
End Sub
nota : préférez la v3a.
@mapomme tu es au top :) :) :)
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas