Option Explicit
Private Sub btnTest_Click()
Dim rng As Range
Dim bin As String
Dim cmb As String
Dim num As Integer
Dim ptr As Byte
Dim sB As Double
Dim sC As Double
Dim sD As Double
Dim sE As Double
Dim sF As Double
Dim sG As Double
Dim sH As Double
Dim sI As Double
Dim sJ As Double
Dim sK As Double
Dim sL As Double
Dim sM As Double
Dim sN As Double
Dim sO As Double
Dim sP As Double
Dim sQ As Double
Dim sR As Double
Dim sS As Double
Dim sT As Double
Dim SomCible As Double
'permet de changer la valeur du critère
SomCible = 40
'zone de destination pour coller les combinaisons
Set rng = Rows(24)
'on efface la zone pour initialiser
rng.Resize(Rows.Count - 24).Clear
'pour 8 titres: 2 puissances 8 -1 combinaisons 256-1 = 255
'pour chaque combinaison possible
For num = 1 To 2 ^ 8 - 1
cmb = ""
sB = 0: sC = 0: sD = 0: sE = 0: sF = 0: sG = 0: sH = 0: sI = 0: sJ = 0: sK = 0: sL = 0: sM = 0: sN = 0: sO = 0: sP = 0: sQ = 0: sR = 0: sS = 0: sT = 0
'on reste sur un mot de 8 bits (8 titres)
bin = Right("00000000" & Binaire(num), 8)
For ptr = 1 To Len(bin)
If Mid(bin, ptr, 1) = "0" Then
'nom de la combinaison qui contient les titres A, B.... H
cmb = cmb & Cells(ptr + 1, "A").Value
'on fait la somme des critères au fur et à mesure (les 20 critères)
sB = sB + Cells(ptr + 1, "B").Value
sC = sC + Cells(ptr + 1, "C").Value
sD = sD + Cells(ptr + 1, "D").Value
sE = sE + Cells(ptr + 1, "E").Value
sF = sF + Cells(ptr + 1, "F").Value
sG = sG + Cells(ptr + 1, "G").Value
sH = sH + Cells(ptr + 1, "H").Value
sI = sI + Cells(ptr + 1, "I").Value
sJ = sJ + Cells(ptr + 1, "J").Value
sK = sK + Cells(ptr + 1, "K").Value
sL = sL + Cells(ptr + 1, "L").Value
sM = sM + Cells(ptr + 1, "M").Value
sN = sN + Cells(ptr + 1, "N").Value
sO = sO + Cells(ptr + 1, "O").Value
sP = sP + Cells(ptr + 1, "P").Value
sQ = sQ + Cells(ptr + 1, "Q").Value
sR = sR + Cells(ptr + 1, "R").Value
sS = sS + Cells(ptr + 1, "S").Value
sT = sT + Cells(ptr + 1, "T").Value
End If
Next ptr
'si à la fin de la combinaison, le sT contient la valeur cible (40 ou 120 ou..)
If sT = SomCible Then
'alors, on copie la combinaison avec les sommes de critère dans le tableau de résultat
rng.Cells(1, "A").Value = cmb
rng.Cells(1, "B").Value = sB
rng.Cells(1, "C").Value = sC
rng.Cells(1, "D").Value = sD
rng.Cells(1, "E").Value = sE
rng.Cells(1, "F").Value = sF
rng.Cells(1, "E").Value = sE
rng.Cells(1, "F").Value = sF
rng.Cells(1, "G").Value = sG
rng.Cells(1, "H").Value = sH
rng.Cells(1, "I").Value = sI
rng.Cells(1, "J").Value = sJ
rng.Cells(1, "K").Value = sK
rng.Cells(1, "L").Value = sL
rng.Cells(1, "M").Value = sM
rng.Cells(1, "N").Value = sN
rng.Cells(1, "O").Value = sO
rng.Cells(1, "P").Value = sP
rng.Cells(1, "Q").Value = sQ
rng.Cells(1, "R").Value = sR
rng.Cells(1, "S").Value = sS
rng.Cells(1, "T").Value = sT
Set rng = rng.Offset(1)
End If
Next num
End Sub
Function Binaire(ByVal Nbre As Long) As String
'cette fonction permet de passer d'une valeur binaire à une autre en changeant les bits un à un..enfin. je crois ;-)
If Int(Nbre / 2) = 0 Then
Binaire = CStr(Nbre Mod 2)
Else
Binaire = Binaire(Int(Nbre / 2)) & CStr(Nbre Mod 2)
End If
End Function
