Salut Manbruce,
Salut la fine équipe,
un double-clic démarre la macro.
Recherche horizontale, verticale, diagonale Haut -> Gauche ou Droite Bas avec série de nombres sans débords sur ligne ou colonne suivante.
Tu peux étendre ta grille jusqu'à 25 colonnes et autant de lignes souhaitées avec une série à rechercher aussi longue que nécessaire.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim rCells As Range, tTab, tNum, iNbRow%, iNbCol%, iNbNum%
'
Cancel = True
Application.ScreenUpdating = False
'
[A1].CurrentRegion.Interior.Color = RGB(255, 255, 255)
tTab = [A1].CurrentRegion.Value
tNum = Range("AA1").Resize(1, Cells(1, Columns.Count).End(xlToLeft).Column - 26).Value
iNbRow = UBound(tTab, 1)
iNbCol = UBound(tTab, 2)
iNbNum = UBound(tNum, 2)
'
For x = 1 To UBound(tTab, 1)
For y = 1 To UBound(tTab, 2)
If tTab(x, y) = tNum(1, 1) Then
For k = 1 To 4
Set rCells = Range(fctCol(y) & x)
Select Case k
Case 1, 2 'Horizontale (1) Verticale (2)
If IIf(k = 1, iNbCol, iNbRow) - IIf(k = 1, y, x) >= iNbNum Then
For Z = 1 To iNbNum - 1
If tTab(x + IIf(k = 1, 0, Z), y + IIf(k = 1, Z, 0)) <> tNum(1, Z + 1) Then Exit For
Set rCells = Union(rCells, Range(fctCol(y + IIf(k = 1, Z, 0)) & x + IIf(k = 1, 0, Z)))
Next
End If
Case Else 'Diagonale ->Droite (3) Gauche (4)
If iNbRow - x >= iNbNum And IIf(k = 3, iNbCol - y, y) >= iNbNum Then
For Z = 1 To iNbNum - 1
If tTab(x + Z, y + IIf(k = 3, Z, Z * -1)) <> tNum(1, Z + 1) Then Exit For
Set rCells = Union(rCells, Range(fctCol(y + IIf(k = 3, Z, Z * -1)) & x + Z))
Next
End If
End Select
If rCells.Count = iNbNum Then rCells.Interior.Color = RGB(215, 215, 215)
Next
End If
Next
Next
'
Application.ScreenUpdating = True
EDIT : une petite coquille (ah, ces copier-coller!) était restée coincée : rectification faite...
A+