السلام عليكم
هذا كود فكرته من معادلة اخي الحبيب رجب جاويش
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> Range("B2").Address Then Exit Sub
Dim cel As Range, rng As Range
Dim t As Double, tt As Double, ttt As Double
t = Val(Target)
With Range("B5:M21")
.Interior.ColorIndex = 6
For Each cel In .Cells
tt = Abs(Val(cel) - t)
If rng Is Nothing Then
Set rng = cel: ttt = tt
Else
If tt = ttt Then Set rng = Union(rng, cel)
If tt < ttt Then Set rng = cel: ttt = tt
End If
Next
End With
rng.Interior.ColorIndex = 10
Set rng = Nothing
End Sub
المرفق 2003
تحياتي
تغيير لون الخلية.rar