Sub tt()
Dim L As Long: L = Cells(Rows.Count, 1).End(xlUp).Row
Dim I As Long, J As Integer
Dim arr
For I = 1 To L
arr = Range("F" & I & ":K" & I)
For J = 1 To UBound(arr, 2)
If arr(1, J) <= 0 Then arr(1, J) = Application.WorksheetFunction.Max(arr)
Next J
Cells(I, 4) = Application.WorksheetFunction.Min(arr)
Next I
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, RN As Range, lr&, m As Range, min As Double
With Application: DisplayAlerts = False: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
     
    With ActiveSheet
    lr = .Cells(.Rows.Count, "F").End(xlUp).Row
    End With
     
    Set Rng = ActiveSheet.Range("F2:K" & lr)
    If Not Rng Is Nothing Then
    Rng.Interior.ColorIndex = xlNone
    
    For rr = 1 To Rng.Rows.Count + 1
   min = 1000 ' исходя из данных любое большое число
 
        For Each RN In Rng.Rows(rr).Cells
            If (IsNumeric(RN.Value) And RN.Value <> 0 And RN.Value <= min) Then
            min = RN.Value: Set m = RN
            Else: min = min
            End If
        Next RN
        m.Interior.ColorIndex = 6
    Next
    End If
With Application: DisplayAlerts = True: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic: End With
End Sub

Sub search()
Dim s As Double, I&, J&, n&, addr$
  n = Range("D2").End(xlDown).Row
For J = 2 To n
 s = Application.Max(Range("G" & J & ":K" & J))
  For I = 1 To 5
  If Range("G" & J & ":K" & J).Cells(I) < s And Range("G" & J & ":K" & J).Cells(I) <> 0 Then
    s = Range("G" & J & ":K" & J).Cells(I)
  End If
  Next I
   Range("D" & J) = s
   addr = Range("G" & J & ":K" & J).Find(s).Address
   Range(addr).Interior.ColorIndex = 3
Next J
End Sub

Sub test1()
Dim J&, n&
 n = Range("D2").End(xlDown).Row
 For J = 2 To n
  Range("G" & J & ":K" & J).Interior.Color = xlNone
 Next J
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F2:K" & Cells(Rows.Count, 1).End(xlUp).Row)) Is Nothing And Target.Count = 1 Then
On Error Resume Next
Application.EnableEvents = False
With Target
    Set arrRow = Range("F" & .Row & ":K" & .Row)
    arrRow.Interior.ColorIndex = xlNone
    For I = 1 To arrRow.Count
        minVal = Application.WorksheetFunction.Small(arrRow, I)
        If minVal <> 0 Then
            Set minCell = arrRow.Find(minVal)
            minCell.Interior.ColorIndex = 6
            Cells(.Row, 4) = minVal
            Exit For
        End If
    Next
End With
Application.EnableEvents = True
End If
End Sub

Sub search2()
Dim s As Double, I&, J&, n&, addr$
  n = Range("D2").End(xlDown).Row
For J = 2 To n
 s = Application.Max(Range("G" & J & ":K" & J))
  For I = 1 To 5
  Set x = Range("G" & J & ":K" & J).Cells(I)
  If x.Value < s And x.Value <> 0 And Not IsEmpty(x) Then
    s = x.Value
  End If
  Next I
   Range("D" & J) = s
   addr = Range("G" & J & ":K" & J).Find(s).Address
   Range(addr).Interior.ColorIndex = 3
Next J
End Sub

min = Application.max(Rng.Cells) 'вместо 1000