Sub MAJ()
Dim h&, ncol1%, ncol2%, ecart&, tablo, boule%, P As Range, t(), i&, lig&
Dim j%, x, test As Boolean, i1&, j1%, k%
h = 33 'hauteur de la plage de recherche
ncol1 = 5: ncol2 = 7 'nombres de colonnes
With Feuil1 'CodeName
ecart = .[P2]
tablo = .Range("B5", .Range("B" & .Rows.Count).End(xlUp)).Resize(, ncol1)
For boule = 1 To ncol1
Set P = .[G5].Offset(, ncol2 * (boule - 1)).Resize(UBound(tablo), ncol2)
ReDim t(1 To UBound(tablo), 1 To ncol2)
For i = 1 To UBound(t)
lig = i
For j = 1 To ncol2
If j = 1 Then x = tablo(i, boule) Else x = t(i, j - 1)
For i1 = lig - 1 To IIf(lig > h, lig - h, 1) Step -1
For j1 = ncol1 To 1 Step -1
If j = 1 Then
test = tablo(i1, j1) <> x
Else
test = True
For k = 1 To j - 1
If tablo(i1, j1) = t(i, k) Then test = False: Exit For
Next
End If
If tablo(i1, j1) >= x - ecart And tablo(i1, j1) <= x + ecart _
And test Then t(i, j) = tablo(i1, j1): lig = i1: GoTo 1
Next j1
Next i1
1 Next j
Next i
'---restitution---
P = t
P.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 38 'rose
On Error Resume Next ' si ecart = 0
P.SpecialCells(xlCellTypeConstants).Interior.ColorIndex = xlNone
On Error GoTo 0
Next boule
End With
End Sub