Modifier code Somme de sous ensemble

[kenzo1245]

Bonjour,

J'ai le programme de TI qui trouve toutes les combinaisons parmi une liste de nombre pour arrivé à la somme voulu.

exemple:
Liste = (14,9,8,7,6,5) - somme à trouver = 22

Résultat 1 : 14 - 8
Résultat 2 : 9 - 8 - 5
Résultat 3 : 9 - 6 - 6

J'aimerais pouvoir le modifier pour qu'il s’arrête au 1er résultat si c'est possible.
Votre aide est la bienvenue. Merci d'avance.

 

[phlaurent55]

Re : Modifier code Somme de sous ensemble

Bonjour Kenzo,

Sub ChercheSomme()
Dim Tableau() As Double, Plage As Range, Cel As Range
Dim Boucle As Integer, NbSol As Long, K As Integer
Dim TabCombin, Boucle2 As Integer, Montant As Double
Dim NbVal As Integer, Mini As Integer, Maxi As Integer

  With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False

    With F4
      Set Plage = .Range("BaseDep", .Range("BaseDep").End(xlDown))
      Set Cel = .Range("Sol1")
      Range(Cel, Cel.End(xlDown)).Resize(, 200).ClearContents
      Montant = .Range("Montant")
      DetermineMinMax .Range("NbValeurs"), Mini, Maxi, Plage.Rows.Count
    End With

    ReDim Tableau(1 To Plage.Rows.Count)
    For Boucle = 1 To Plage.Rows.Count
      Tableau(Boucle) = Plage.Cells(Boucle, 1)
    Next Boucle

    For K = Mini To Maxi
      DoEvents
      TabCombin = SommeKSurN(Tableau, K, Montant)
      If IsArray(TabCombin) Then
        For Boucle = LBound(TabCombin, 2) To UBound(TabCombin, 2)
          NbSol = NbSol + 1
          Cel = NbSol
          For Boucle2 = 1 To K
            Cel.Offset(0, Boucle2) = TabCombin(Boucle2, Boucle)
          Next Boucle2
          Set Cel = Cel.Offset(1, 0)
          Exit Sub
        Next Boucle
      End If
    Next K
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
  End With
End Sub

Voir ajout de " Exit Sub " à la 8 ème ligne en partant du bas

à+
Philippe

 

[kenzo1245]

Re : Modifier code Somme de sous ensemble

Bonjour,

Super, merci beaucoup!