Sub Calcul()
DL = Range("B65500").End(xlUp).Row
Range("C4:C" & DL).ClearContents
T = Range("B4:B" & DL)
S = [D3]: Tmax = UBound(T)
ReDim T2(2 ^ Tmax, Tmax)
For i = 0 To 2 ^ Tmax
Nbin = DecBin(i)
For j = 0 To Tmax
Valbit = Mid(Nbin, Len(Nbin) - j, 1)
If Valbit = "1" Then
On Error Resume Next
T2(i, j) = T(j + 1, 1)
Else
T2(i, j) = 0
End If
Next j
Next i
For i = 0 To UBound(T2)
somme = 0
For j = 0 To Tmax
somme = somme + T2(i, j)
Next j
If somme = S Then Exit For
Next i
If somme = 0 Then
MsgBox "Pas de solution trouvée."
Else
For k = 0 To Tmax
If T2(i, k) <> 0 Then Range("C" & k + 4) = "A"
Next k
End If
End Sub
Function DecBin(ByVal N As Long) As String
Dim C$
Do While N > 1
C = N - 2 * (N \ 2) & C
N = N \ 2
Loop
DecBin = Right("0000000000000000" & N & C, 16)
End Function