le code corrigé, mais il manque de rapidité et j'ai bien 44 pour la première paire
ption Explicit
Sub TrouvePaireLRD()
Dim Chiffre As Integer ' correspondra aux colonnes
Dim Duo As Integer, Total_Duo As Long ' duo correspondra aux lignes
Dim Ligne As Long, I, j
Dim Deb_Zone As Long, Fin_Zone As Long
Dim Cel As Range
Deb_Zone = 2
Fin_Zone = 456
Ligne = Deb_Zone
Application.ScreenUpdating = False
Sheets("Feuil1").Range("B2:BS71").ClearContents
With Sheets("keno_202010")
For Chiffre = 1 To 69
For Duo = Chiffre + 1 To 70
Do
DoEvents
If .Cells(Ligne, 1).Value = "" Then Exit Do
If Ligne > Fin_Zone Then Exit Do
Set Cel = .Range(.Cells(Ligne, 5), .Cells(Ligne, 20)).Find(Chiffre, LookAt:=xlWhole)
If Not Cel Is Nothing Then
Set Cel = .Range(.Cells(Ligne, 5), .Cells(Ligne, 20)).Find(Duo, LookAt:=xlWhole)
If Not Cel Is Nothing Then
Total_Duo = Total_Duo + 1
End If
End If
Ligne = Ligne + 1
Loop
Sheets("Feuil1").Cells(Duo + 1, Chiffre + 1).Value = Total_Duo
Total_Duo = 0
Ligne = 2
Next Duo
Next Chiffre
End With
End Sub
@ bientôt
LouReeD