Public Sub check1()
    Dim rng1 As Range, unoCell As Range
    Dim maxV(1 To 3) As Long
    
    With Worksheets("Лист1")
        If rng1 Is Nothing Then Set rng1 = .Range("D4:M4")
        i = .Range("N4").Value2
        Do While (i > 4)
            For Each unoCell In rng1
                If unoCell.Value >= maxV(1) Then
                    maxV(1) = unoCell.Value
                    maxV(2) = unoCell.Row
                    maxV(3) = unoCell.Column
                End If
            Next
            .Cells(maxV(2), maxV(3)).Value = ""
            .Range("N4").Select
            Selection.Calculate
            i = .Range("N4").Value2
            maxV(1) = 0
        Loop
        i = .Range("O4").Value2
        maxV(1) = 1000
        Do While (i > 4)
            For Each unoCell In rng1
                If unoCell.Value <= maxV(1) Then
                    maxV(1) = unoCell.Value
                    maxV(2) = unoCell.Row
                    maxV(3) = unoCell.Column
                End If
            Next
            .Cells(maxV(2), maxV(3)).Value = ""
            .Range("O4").Select
            Selection.Calculate
            i = .Range("O4").Value2
            maxV(1) = 1000
        Loop
    End With
End Sub

Sub tt()
    Dim d_ As Range 'd - массив ячеек
    Application.ScreenUpdating = 0 'отключаем обновление экрана
    r1_ = Range("D" & Rows.Count).End(xlUp).Row 'последняя заполненная строка в столбце D
    r0_ = 4 'первая строка
    n_ = 10 'кол-во столбцов
    For i = r0_ To r1_ 'цикл по строкам
        Set d_ = Range("D" & i).Resize(, n_) 'говорим, что d будет n ячеек вправо от столбца D i-ой строки
        x1_ = 0
        x2_ = 0
        For j = 1 To n_ ' цикл от одного до n (больше, чем n ячеек удалить просто не получится)
            'блок 1
            If x1_ = 0 Then 'если x1_=0, то
                mx_ = WorksheetFunction.Max(d_) 'ищем максимум по d
                mn_ = WorksheetFunction.Min(d_) 'ищем минимум по d
                On Error Resume Next 'пропускаем ошибку (на случай, если все значения пусты или =0)
                av_ = WorksheetFunction.Average(d_) 'ищем среднее по d
                e1_ = Err.Number ' присваиваем e значение ошибки (для деления на 0 ошибка 1004, иначе - false)
                On Error GoTo 0 'убираем пропуск ошибок
                z1_ = (mx_ - av_ <= 4) + e1_ = 0 'mx_ - av_ <= 4 даст true или false и плюс e
                    'даст 0 тогда, когда уже не нужно удалять лишнее
                If z1_ Then ' если z1 не 0, то
                    n1_ = WorksheetFunction.Match(mx_, d_, 0) 'ПОИСКПОЗом ищем позицию максимума в d
                    Range("D" & i).Offset(, n1_ - 1).ClearContents 'стираем ее
                Else 'если z1 = 0, то
                    x1_ = 1 'присваиваем х1 единицу
                    If x2_ Then 'если при этом и х2 тоже единица, то
                        Exit For 'выход из цикла
                    End If
                End If
            End If
            'блок 2 аналогично блоку 1
            If x2_ = 0 Then
                mn_ = WorksheetFunction.Min(d_)
                On Error Resume Next
                av_ = WorksheetFunction.Average(d_)
                e2_ = Err.Number
                On Error GoTo 0
                z2_ = (av_ - mn_ <= 4) + e2_ = 0
                If z2_ Then
                    n2_ = WorksheetFunction.Match(mn_, d_, 0)
                    Range("D" & i).Offset(, n2_ - 1).ClearContents
                Else
                    x2_ = 1
                    If x1_ Then
                        Exit For
                    End If
                End If
            End If
        Next j
    Next i
End Sub

Intersect(Rows(i), Range("U:U,AL:AM,AS:as,AV:AX")).ClearContents