Function Nb_Duos(Cel1 As Range, Cel2 As Range) As Byte
Application.Volatile
Dim I As Byte, J As Byte, X As Byte
Dim Les_Duos As Object
Dim Tbl_Lig, Tbl_Col, Tbl
Dim Plg As Range, Cel As Range
Tbl_Lig = Application.Transpose(Range("B2:G2")): Tbl_Col = Range("A3:A20")
Set Les_Duos = CreateObject("Scripting.Dictionary")
For I = LBound(Tbl_Lig) To UBound(Tbl_Lig)
For J = LBound(Tbl_Col) To UBound(Tbl_Col)
Les_Duos(Tbl_Lig(I, 1) & ";" & Tbl_Col(J, 1)) = 0
Next J
Next I
For X = 25 To 65 Step 5
Set Plg = Cells(X, 1).Resize(3, 6)
Tbl = Application.Transpose(Plg)
For I = 1 To 6
For J = 2 To 3
Les_Duos(Tbl(I, 1) & ";" & Tbl(I, J)) = Les_Duos(Tbl(I, 1) & ";" & Tbl(I, J)) + 1
Next J
Next I
Next X
Nb_Duos = Les_Duos(Cel1 & ";" & Cel2)
End Function