Trouver des polynomes dans une liste

Bonjour à tous,

Je suis un petit nouveau sur ce forum. J'ai trouvé sur le net une macro Excel capable de trouver des binômes parmi une liste de numéros. J'ai réussi à la modifier quelque peu mais je n'arrive pas à trouver le code macro pour obtenir 6 numéros (polynôme) qui sortent souvent ensemble. Pouvez-vous m'aider?

Merci

Sub Polynome()

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .EnableEvents = False
    .CutCopyMode = False
    .Calculation = xlCalculationManual
End With

Const Nb = (70 * 70 - 70) / 2
Dim i, j, k, l, m, p, q, r, s
Dim Vals, DerLig
Dim Bin1(Nb), Bin2(Nb), Bin3(Nb), Bin4(Nb), Bin5(Nb), Bin6(Nb), BinNbr(Nb), BinTirage(Nb)
Dim OK, T1

Sheets("stat").Activate

DerLig = 10
DerLig = Application.InputBox(prompt:="Nombre de tirage à prendre en compte (0 = tout) ?", Default:=10, Type:=1)

If DerLig = 0 Then
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
Else
    DerLig = DerLig + 1
End If

Vals = Range("E18:X18").Resize(DerLig - 1)

'remplissage
For i = 1 To 70
    For j = i + 1 To 70
    p = j + 1
    q = p + 1
    r = q + 1
    s = r + 1
        m = m + 1
        Bin1(m) = i: Bin2(m) = j: Bin3(m) = p: Bin4(m) = q: Bin5(m) = r: Bin6(m) = s
    Next j
Next i

'boucle comptage
For m = 1 To Nb
    For i = 1 To DerLig - 1
        OK = 0
        'recherche du 1ier nombre
        For j = 1 To 20
            If Vals(i, j) = Bin1(m) Then Exit For
        Next j
        If j < 21 Then
            For k = j + 1 To 20
                If Vals(i, k) = Bin2(m) Then
                    BinNbr(m) = BinNbr(m) + 1
                    BinTirage(m) = i & " " & BinTirage(m)
                    Exit For
                End If
            Next k
        End If
    Next i
Next m
'boucle comptage2
For m = 1 To Nb
    For j = 1 To DerLig - 1
        OK = 0
        'recherche du 1ier nombre
        For p = 1 To 20
            If Vals(j, p) = Bin1(m) Then Exit For
        Next p
        If j < 21 Then
            For k = p + 1 To 20
                If Vals(j, k) = Bin3(m) Then
                    BinNbr(m) = BinNbr(m) + 1
                    BinTirage(m) = j & " " & BinTirage(m)
                    Exit For
                End If
            Next k
        End If
    Next j
Next m

'écriture des résultats
With Sheets("Polynome").Activate
[A2:BBB2500].ClearContents
Range("R1") = DerLig - 1
Const ColBase = "A"
Dim NcolBase, TT
NcolBase = Range(ColBase & 1).Column

For m = 1 To Nb
    Cells(m + 1, NcolBase) = Bin1(m) & ", " & Bin2(m) & ", " & Bin3(m) & ", " & Bin4(m) & ", " & Bin5(m) & ", " & Bin6(m)
    Cells(m + 1, NcolBase).Offset(, 3) = BinNbr(m)
    If BinNbr(m) >= 1 Then
        TT = Split(BinTirage(m))
        Cells(m + 1, NcolBase).Offset(, 4).Resize(, UBound(TT) - LBound(TT) + 1) = TT
    End If
Next m
End With

Range("a1").Select

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .EnableEvents = True
    .CutCopyMode = True
    .Calculation = xlCalculationAutomatic
End With

End Sub