Sub Compte()
Dim t1, t2, ub&, t(), i&, source$, j&, mem%, col As Byte, p%
t1 = Sheets("Jeux").[B11].CurrentRegion 'matrice, plus rapide
t2 = Feuil1.[A1].CurrentRegion 'matrice, plus rapide
ub = UBound(t2)
ReDim t(1 To ub, 1 To 1)
For i = 2 To UBound(t1)
source = " " & Join(Application.Index(t1, i, 0)) & " "
For j = 1 To ub
mem = 0
For col = 1 To 3
p = InStr(source, " " & t2(j, col) & " ")
If p > mem Then mem = p Else GoTo 1
Next
t(j, 1) = t(j, 1) + 1
1 Next
Next
'---restitution---
With Feuil1.[EW1]
.Resize(ub) = t
.Offset(ub).Resize(.Parent.Rows.Count - ub).ClearContents
End With
End Sub