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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
Option Compare Database
Option Explicit
Option Base 1
Dim m_vntaAmounts As Variant
Dim m_intaBound() As Integer
Dim m_intaData() As Integer
Dim m_intDataIndex As Integer
Dim m_strComboResult As String
Dim m_intSubGroup As Integer
Dim m_intCountCombo As Integer
Public Sub GetCombinaisons()
Const SQL As String = "SELECT * FROM tblCombinaison WHERE Fournisseur ='Durandal'"
Dim oRS As DAO.Recordset
Dim sngaAmounts() As Integer
Dim intMaxValue As Integer
Dim strMaxValue As String
Dim V As Integer
m_strComboResult = vbNullString
m_intCountCombo = 0
m_intSubGroup = 0
strMaxValue = InputBox("Quel montant pour la combinaison ?", "Amount", 100)
intMaxValue = CInt(strMaxValue)
If Len(strMaxValue) And IsNumeric(strMaxValue) Then
Set oRS = CurrentDb.OpenRecordset(SQL, dbOpenDynaset)
With oRS
Do While Not .EOF
V = V + 1
ReDim Preserve sngaAmounts(1 To V)
sngaAmounts(V) = .Fields("Montant").Value
.MoveNext
Loop
.Close
End With
Set oRS = Nothing
End If
m_vntaAmounts = sngaAmounts
Call CreateCombos(m_vntaAmounts, intMaxValue)
MsgBox m_strComboResult, , m_intCountCombo & " combinaisons trouvées"
Erase m_vntaAmounts
Erase m_intaBound
Erase m_intaData
End Sub
Private Sub CreateCombos(ByRef m_vntaAmounts, ByVal MaxAmount As Integer)
Dim intIndex As Integer
m_intDataIndex = 0
ReDim m_intaBound(UBound(m_vntaAmounts))
ReDim m_intaData(CountCombos(UBound(m_vntaAmounts)), UBound(m_vntaAmounts) + 1)
For intIndex = 1 To UBound(m_vntaAmounts)
m_intSubGroup = intIndex
CreateSingleCombo 1, 0
Next intIndex
FindSumAndPrint MaxAmount
End Sub
Private Sub StoreCombo()
Dim I As Integer
Dim intSum As Integer
m_intDataIndex = m_intDataIndex + 1
For I = 1 To UBound(m_vntaAmounts)
If m_intaBound(I) = 0 Then
m_intaData(m_intDataIndex, I) = 0
Else
m_intaData(m_intDataIndex, I) = m_vntaAmounts(I)
intSum = intSum + m_vntaAmounts(I)
End If
Next I
m_intaData(m_intDataIndex, UBound(m_vntaAmounts) + 1) = intSum
End Sub
Private Sub CreateSingleCombo(ByVal J As Integer, ByVal M As Integer)
If J > UBound(m_vntaAmounts) Then
StoreCombo
Else
If m_intSubGroup - M < UBound(m_vntaAmounts) - J + 1 Then
m_intaBound(J) = 0
CreateSingleCombo J + 1, M
End If
If M < m_intSubGroup Then
m_intaBound(J) = 1
CreateSingleCombo J + 1, M + 1
End If
End If
End Sub
Private Function CountCombos(ByVal Num As Integer) As Long
Dim I As Integer
For I = 1 To Num
CountCombos = CountCombos + Factorial(Num) / (Factorial(Num - I) * Factorial(I))
Next I
End Function
Private Function Factorial(ByVal Num As Integer) As Long
Dim I As Integer
Factorial = 1
For I = 1 To Num
Factorial = Factorial * I
Next I
End Function
Private Sub FindSumAndPrint(ByVal SearchValue As Integer)
Dim I As Integer
Dim J As Integer
For I = 1 To UBound(m_intaData, 1)
If m_intaData(I, UBound(m_intaData, 2)) = SearchValue Then
For J = 1 To UBound(m_intaData, 2) - 1
If m_intaData(I, J) <> 0 Then
m_strComboResult = m_strComboResult & vbCrLf & "Montant : " & m_intaData(I, J)
End If
Next J
m_intCountCombo = m_intCountCombo + 1
m_strComboResult = m_strComboResult & vbCrLf & String(15, "_") & vbCrLf & "Combinaison #" & m_intCountCombo & vbCrLf
End If
Next I
End Sub |
Recherche de combinaisons
Répondre avec citation
Partager