Bonjour le forum,

Je vous joins le code pour savoir ce qui cloche, car je l'ai fait tourner pendant 1h30 (repas) et aucun message n'est indiqué.
Colonne A, une 50 de chiffres
Colonne B, le montant a trouver avec les chiffres de la colonne A.

Le code est installer sur : Feuil1(Feuil1)

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Option Explicit
 
Public Sub GetAllDecompo()
    Dim listNumber As New Collection
    Dim total As Double
    Dim result As Collection
    Dim i, j As Double
    Dim str As String
 
    Dim ws As Worksheet
    Set ws = Worksheets("Feuil1")
    ws.Range("C:C").ClearContents
 
    'On récupère les paramètres sur la feuille
    i = 1
    While ws.Cells(i, 1) <> ""
        listNumber.Add ws.Cells(i, 1).Value
        i = i + 1
    Wend
    total = ws.Cells(1, 2).Value
 
    'On lance la fonction
    Set result = decompo(listNumber, total)
 
    'On écrit les résultats
    For i = 1 To result.Count
        str = ""
        For j = 1 To result(i).Count
            str = str & result(i)(j) & "+"
        Next j
        str = Left(str, Len(str) - 1)
        ws.Cells(i, 3).Value = str
    Next i
End Sub
 
Private Function decompo(ByVal listN As Collection, ByVal total As Double) As Collection
    Dim c As New Collection
    Dim cTemp As Collection
    Dim newTotal As Double
    Dim tmpNb As Double
    Dim i As Double
 
    Dim tmpListN As Collection
 
    'S'il n'y a plus qu'un élément, on l'ajoute dans la collection s'il est égal au total
    If listN.Count = 1 Then
        If listN(1) = total Then
            Set cTemp = New Collection
            cTemp.Add total
            c.Add cTemp
        End If
    ElseIf listN.Count > 1 Then
        newTotal = total - listN(1)
        Set tmpListN = getCopy(listN)
        'Sinon, listN ne retrouve pas ses valeurs quand on remonte d'un cran dans la récursivité
        tmpNb = listN(1)
        tmpListN.Remove 1 'On enlève le premier nombre de la liste
 
        'On regarde si on peut faire le total avec les autres
        Set cTemp = decompo(tmpListN, total)
        For i = 1 To cTemp.Count
            c.Add cTemp(i)
        Next i
 
        'Puis on regarde si on peut faire avec les autres le total moins celui là
        If newTotal = 0 Then 'On a notre somme
            Set cTemp = New Collection
            cTemp.Add tmpNb
            c.Add cTemp
        ElseIf newTotal > 0 Then 'On regarde la somme avec le nouveau total
            Set cTemp = decompo(tmpListN, newTotal)
            For i = 1 To cTemp.Count
                cTemp(i).Add tmpNb
                c.Add cTemp(i)
            Next i
        End If
    End If
 
    Set decompo = c
End Function
 
Private Function getCopy(ByVal c As Collection) As Collection
    Dim c2 As New Collection
    Dim i As Double
    For i = 1 To c.Count
        c2.Add c(i)
    Next i
    Set getCopy = c2
End Function
Si quelqu'un peut me dire ce qui cloche dans le code, je le remercie d'avance.
Bonne journée.