Matcher des nombres pour obtenir un certain total
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:
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.
