Probabilités : série de chiffres : arriver à un montant

marech

XLDnaute Nouveau
Bonjour à tous et à toutes,
Je n'ai pas trouvé de réponse à mon problème en fouillant ds le forum, alors je poste une nouvelle discussion :
J'ai une série de nombres, et je voudrais savoir, en en additionnant certains entre eux, si je peux arriver à un montant prédéfini (ou approximativement ce montant).

Voir en PJ mon problème,

Merci d'avance à ceux qui peuvent m'apporter une (des) solutions,
Et meilleurs vœux 2011 !
A bientôt,
Marech.
 

Pièces jointes

  • GLT 2010.xls
    28.5 KB · Affichages: 173

PMO2

XLDnaute Accro
Re : Probabilités : série de chiffres : arriver à un montant

Bonjour,

Une piste avec le code suivant à copier dans un module standard

Code:
'### Constante à adapter (nom de la feuille source) ###
Const BASE As String = "Sage"
'######################################################

Sub ApprocheMontant()
Dim S As Worksheet
Dim R As Range
Dim Cible#
Dim g&
Dim i&
Dim j&
Dim k&
Dim var
Dim Total#
Dim T()
Cible# = Sheets(BASE).[g1]
Sheets(BASE).Copy after:=Sheets(1)
Set S = ActiveSheet
S.Rows("1:2").Delete
S.Columns("A:E").Delete
Set R = S.Range(S.Cells(1, 1), S.Cells(S.[a65536].End(xlUp).Row, 1))
R.Sort Key1:=S.[a1], Order1:=xlAscending, Header:=xlNo
var = R
For i& = UBound(var, 1) To 1 Step -1
  k& = k& + 1
  ReDim Preserve T(1 To 256, 1 To k&)
  T(3, k&) = var(i&, 1)
  Total# = var(i&, 1)
  T(2, k&) = Total#
  g& = 3
  For j& = i& - 1 To 1 Step -1
    If var(i&, 1) > 0 Then
      If Total# + var(j&, 1) <= Cible# Then
        g& = g& + 1
        If g& > 256 Then Exit For
        T(g&, k&) = var(j&, 1)
        Total# = Total# + var(j&, 1)
        T(2, k&) = Total#
      End If
    End If
  Next j&
  T(1, k&) = Total# / Cible#
Next i&
S.Cells.Delete
Set R = S.Range(S.Cells(1, 1), S.Cells(UBound(T, 2), UBound(T, 1)))
R = Application.WorksheetFunction.Transpose(T)
R.NumberFormat = "0 000.00"
R.Sort Key1:=S.[a1], Order1:=xlDescending, Header:=xlNo
Set R = S.Range(S.Cells(1, 1), S.Cells(UBound(T, 2), 1))
R.NumberFormat = "0.000%"
With R.Font
  .Bold = True
  .Color = vbRed
End With
Set R = R.Offset(0, 1)
With R.Font
  .Bold = True
  .Color = vbBlue
End With
End Sub


Le résultat s'inscrit dans une nouvelle feuille. Toutes les valeurs sont explorées.
La colonne A (en rouge) est le pourcentage d'approche. La colonne B (en bleu) est le total des valeurs d'approche.
Les colonnes C et plus sont les valeurs d'approche.

Cordialement.

PMO
Patrick Morange
 

Discussions similaires

Statistiques des forums

Discussions
312 239
Messages
2 086 503
Membres
103 236
dernier inscrit
Menni