Sub calcul()
debut = Timer
ligne = 1
feuille = 2
Set dico = CreateObject("Scripting.dictionary")
a = Array("BD", "AB", "AC", "AD", "AE", "BC", "BE", "CD", "CE", "DE")
b = Array("CDAB", "ABCD", "ABCE", "ACBD", "ACBE", "ADBC", "ADBE", "AEBC", "AEBD", "BCAD", "BCAE", "BDAC", "BDAE", "BEAC", "BEAD", "CDAE", "CEAB", "CEAD", "DEAB", "DEAC")
c = Array("CE", "AC", "AD", "AE", "CD", "DE")
d = Array("BC", "AB", "AC", "AD", "BD", "CD")
e = Array("ACBD", "ABCD", "ADBC", "BCAD", "BDAC", "CDAB")
Valeurs = Array(4, 4, 4, 4, 4, 4, 4, 4, 2, 2, 4, 4, 4, 4, 1.5, 1.5, 1.5, 1.5, 4, 4, 4, 4, 2, 2)
For n = LBound(a) To UBound(a)
For m = LBound(b) To UBound(b)
For nn = LBound(c) To UBound(c)
For nnn = LBound(a) To UBound(a)
For nnnn = LBound(a) To UBound(a)
For nnnnn = LBound(a) To UBound(a)
For nnnnnn = LBound(a) To UBound(a)
For nnnnnnn = LBound(a) To UBound(a)
For mm = LBound(d) To UBound(d)
For mmm = LBound(e) To UBound(e)
Set dico = CreateObject("Scripting.dictionary")
code = a(n) & b(m) & c(nn) & a(nnn) & a(nnnn) & a(nnnnn) & a(nnnnnn) & d(mm) & e(mmmm)
nbcode = nbcode + 1
If nbcode > 1000000 Then
MsgBox (Timer - debut)
Exit Sub
End If
For p = 1 To Len(code)
x = Mid(code, p, 1)
dico(x) = dico(x) + Valeurs(p - 1)
Next p
aa = dico.keys
bb = dico.items
For q = LBound(aa) To UBound(aa)
'Sheets("Feuil" & feuille).Range(aa(q) & ligne) = bb(q)
If aa(q) = "A" And bb(q) = 18 Then ok = ok + 1
If aa(q) = "B" And bb(q) = 14 Then ok = ok + 1
If aa(q) = "C" And bb(q) = 19 Then ok = ok + 1
If aa(q) = "D" And bb(q) = 18 Then ok = ok + 1
If aa(q) = "E" And bb(q) = 9 Then ok = ok + 1
Next q
If ok = 5 Then
Sheets("Feuil" & feuille).Cells(ligne, 6) = code
For q = LBound(aa) To UBound(aa)
Sheets("Feuil" & feuille).Range(aa(q) & ligne) = bb(q)
Next q
ligne = ligne + 1
Exit Sub
End If
If ligne = Rows.Count Then
feuille = feuille + 1
ligne = 1
End If
Set dico = Nothing
ok = 0
Next mmm
Next mm
Next
Next
Next
Next
Next
Next nn
Next m
Next
End Sub