XL 2010 Accélérer vba excel 2007

Sub Decompte()
T0 = Timer
Dim T(), Nbres(), Result()
Range("A5:A55000").ClearContents
ReDim T(55994, 4), Result(55994)
Nbres = Range("B4:F4")
For i = 0 To 55994
   For j = 0 To 4
      For k = 1 To 5
      If T(i, j) = Nbres(1, k) Then N = N + 1
      Next k
   Next j
Result(i) = N: N = 0
Next i
Cells(6, 1).Resize(UBound(Result)) = Application.Transpose(Result)
If Application.CountIf(Range("A6:A55000"), 5) > 0 Then Range("A5") = "trouvé"
MsgBox Timer - T0
End Sub

Sub Decompte()
T0 = Timer
Dim T(), Nbres(), Result()
[A5] = ""
ReDim T(65500, 4), Result(55994)
Nbres = Range("B4:F4")
T = Range("B5:F65000")
For i = 1 To 65000
    N = 0
    For j = 1 To 5
        For k = 1 To 5
            If T(i, j) = Nbres(1, k) Then N = N + 1
        Next k
        If N = 5 Then
            Cells(5, 1) = "Trouvé en ligne " & i + 4
            GoTo Fin
        End If
   Next j
Next i
Exit Sub
Fin:
MsgBox "Temps execution : " & Timer - T0 & "s."
End Sub

Sub Decompte()
Dim d As Object, j%, tablo, ub&, i&, n%
Set d = CreateObject("Scripting.Dictionary")
For j = 2 To 6: d(Cells(4, j).Value) = "": Next j 'liste sans doublon
With Range("A6", Range("F" & Rows.Count).End(xlUp)).Resize(, 6)
    If .Row < 6 Then Exit Sub
    tablo = .Value 'matrice, plus rapide
    ub = UBound(tablo)
    For i = 1 To ub
        n = 0
        For j = 2 To 6
            If d.exists(tablo(i, j)) Then n = n + 1
        Next j
        tablo(i, 1) = n
    Next i
    '---restitution---
    .Columns(1) = Application.Index(tablo, 0, 1)
    ..Rows(1).Offset(ub).Resize(Rows.Count - ub - .Row + 1).ClearContents 'RAZ en dessous
End With
End Sub