Bonsoir
voici donc une macro pour résoudre un problème qui n'a pas besoin d'une calculette
la macro t'affiche le nombre d'articles à mettre dans ton panier pour obtenir 3000 gr au coût le moins élevé.
Dim poids(8), prix(8), solu(100), solution(1000, 8), solutprix, sol, minip, mini
Sub ntest()
sol = 0
mini = 10000000000#
panier = 3000
'on recherche le produit le moins cher au gramme
For i = 1 To 8
poids(i) = Cells(i + 1, 2)
prix(i) = Cells(i + 1, 1)
q = Int(panier / poids(i))
pm = q * prix(i)
'Cells(i + 1, 3) = pm
If pm < mini Then mini = pm: miniv = i: miniq = q: minip = miniq * poids(i)
Next i
If minip < panier Then
While True 'on recherche si on doit compléter le panier
If trouvesolution(panier - minip, miniv, 1) Then
' cherche meilleure solution parmi les solutions possibles
mini = 10000000000#
MsgBox "nombre de solutions envisagées " & sol
For j = 1 To sol
For k = 1 To 8
If k = miniv Then
p = p + miniq * prix(miniv)
Else
p = p + solution(j, k) * prix(k)
End If
Next k
If p < mini Then mini = p: minisol = j
Next j
For k = 1 To 8
If k = miniv Then
Cells(k + 1, 3) = miniq
Else
Cells(k + 1, 3) = solution(minisol, k)
End If
Next k
Exit Sub
Else
minip = minip - poids(miniv)
miniq = miniq - 1
End If
Wend
Else
MsgBox "le panier le moins cher est de " & miniq & " articles " & miniv
Cells(miniv + 1, 3) = miniq
End If
End Sub
Function trouvesolution(valeur, miniv, start, Optional niveau = 1)
For i = start To 8
If i <> miniv Then
If poids(i) < valeur Then
solu(niveau) = i
ok = trouvesolution(valeur - poids(i), miniv, i, niveau + 1)
ElseIf poids(i) = valeur Then
solu(niveau) = i
sol = sol + 1
Dim z(8)
For j = 1 To niveau
z(solu(j)) = z(solu(j)) + 1
Next j
For j = 1 To 8
Cells(j + 1, sol + 3) = z(j)
solution(sol, j) = z(j)
Next j
Exit Function
End If
End If
Next i
If sol > 0 Then trouvesolution = True
End Function