Macro de séléction aléatoire

[vinz602]

Bonjour à tous

Après quelques recherches sur les fonctions aléatoires, je ne vois pas comment combiner des formules pour atteindre le résultat que je souhait, je ne vois que la solution par une macro, mais là je n'y connais rien

Fichier en PJ

Feuille1, ma feuille de calcul
Feuille2, listing produit

je souhaiterai sélectionner une liste de produit aléatoire sur la feuille 1 par rapport au montant valeur offert
et par rapport au listing de produits feuille 2 où se trouve le prix

Bien sur la somme des produits sélectionner ne doit pas dépasser la valeur offerte.

Merci pour votre aide

 

[vinz602]

Re : Macro de séléction aléatoire

je vois des tonnes de topic mais je vois pas comment les combiner???

 

[Dranreb]

Re : Macro de séléction aléatoire

Bonjour.

Un essai par macro.

 

[vinz602]

Re : Macro de séléction aléatoire

Tu es un boss, mon dieu lol

 

[Dranreb]

Re : Macro de séléction aléatoire

Une variante de la procédure qui retient la 1ère aboutie de 1000 tentatives maxi d'obtenir la somme juste, à défaut celle qui s'en rapproche le plus des 1000 essayées:

Sub Tirage()
Dim Te() As Variant, SMax As Double, SMeil As Double, Tentative As Long, LA As New ListeAléat, _
   Tt() As Long, Lt As Long, STent As Double, Ls As Long, Le As Long, Tm() As Long, Ts(), LsMax As Long
Te = Feuil2.[A2:B2].Resize(Feuil2.[A60000].End(xlUp).Row - 1).Value
SMax = Feuil1.[A2].Value
Randomize
SMeil = 0
For Tentative = 1 To 1000
   LA.Init UBound(Te)
   STent = 0: ReDim Tt(1 To 50): Lt = 0
   Do
      Le = LA.AléatSuc
      If Le = 0 Then Exit Do
      If Te(Le, 2) <= SMax - STent Then
         Lt = Lt + 1: Tt(Lt) = Le
         STent = STent + Te(Le, 2): End If: Loop Until STent = SMax
   If STent > SMeil Then SMeil = STent: ReDim Preserve Tt(1 To Lt): Tm = Tt: If STent = SMax Then Exit For
   Next Tentative
LsMax = UBound(Tm)
ReDim Ts(1 To LsMax, 1 To 2)
For Ls = 1 To LsMax: Le = Tm(Ls): Ts(Ls, 1) = Te(Le, 1): Ts(Ls, 2) = Te(Le, 2): Next Ls
Feuil1.[8:50].Delete
Feuil1.[A8].Resize(LsMax, 2).Value = Ts
With Feuil1.[A8].Offset(LsMax): .Value = "Total :": .HorizontalAlignment = xlRight: End With
Feuil1.[B8].Offset(LsMax).FormulaR1C1 = "=SUBTOTAL(9,R8C:R[-1]C)"
With Feuil1.[A8:B8].Resize(LsMax + 1).Borders: .Weight = xlThin: .Weight = xlThin: .Color = RGB(0, 102, 0): End With
Feuil1.[A8:B8].Offset(LsMax).Borders(xlEdgeTop).Weight = xlMedium
End Sub