Option Explicit
Private Sub btnTest_Click()
'
Const tot = 260 'Total attendu pour la combinaison
Const nbv = 20 'nombre de valeurs à combiner
Const n°L = 25 'n° de ligne de destination de la 1° combinaison retenue
'
Dim rng As Range 'ligne de destination des combinaisons
Dim bin As String 'nombre binaire
Dim cmb As String 'combinaison
Dim num As Long 'numéro de combinaison
Dim ptr As Byte 'pointeur de digit binaire
Dim sB As Double 'somme colonne B
Dim sC As Double 'somme colonne C
Dim sD As Double 'somme colonne D
Dim sE As Double 'somme colonne E
Dim sF As Double 'somme colonne F
'Définir la ligne de destination des combinaisons
Set rng = Rows(n°L)
'Effacer les éventuels résultats précédents
rng.Resize(Rows.Count - n°L).Clear
'Arrêter l'actualisation écran et les calculs automatiques
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Analyser toutes les combinaisons possibles, en faisant
' varier un nombre de 1 à 2^nbre de valeurs à combiner - 1
' pour ABCDEFGHIJKLMNOPQRST
' de 00000000000000000001 en binaire
' à 11111111111111111111 en binaire
For num = 1 To 2 ^ nbv - 1
'(ré)Initialiser les variables
cmb = ""
sB = 0: sC = 0: sD = 0: sE = 0: sF = 0
' Convertir num en chaine binaire de nbv digits
bin = Right(String(nbv, "0") & Binaire(num), nbv)
' Analyser chacun des digits
For ptr = 1 To Len(bin)
' Pour chaque digit est égal à 0 ...
If Mid(bin, ptr, 1) = "0" Then
' ... faire la somme la valeur en colonne F
sF = sF + Cells(ptr + 1, "F").Value
' ... mémoriser la combinaison
cmb = cmb & Cells(ptr + 1, "A").Value
' ... et faire la somme des autres valeurs de la ligne
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
End If
Next ptr
' Si la somme F correspond à la valeur attendue ...
If sF = tot Then
'... écrire la combinaison et les sommes
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
' ... definir la destination de la combinaison suivante
Set rng = rng.Offset(1)
End If
Next num
'Rétablir l'actualisation écran et les calculs automatiques
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Function Binaire(ByVal Nbre As Long) As String
' Cette fonction récursive permet de convertir un
' nombre décimal (Nbre) en chaine binaire (Binaire)
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
