Function Интерполяция(ДиапазонA As String, ДиапазонB As String, ДиапазонДанных As String, F19 As Double, F22 As Double, F24 As Double) As Variant
 Dim A As Range, B As Range, Data As Range
 Dim TargetValue As Double
 Dim MinA As Double, MaxA As Double
 Dim RowIndex As Long, ColIndex As Long
 Dim MinB As Double, MaxB As Double
 Dim ColIndexMax As Long
 Dim Y1 As Double, Y2 As Double
 Dim MinA_found As Boolean, MinB_found As Boolean, MaxB_found As Boolean

 ' Устанавливаем диапазоны
 On Error Resume Next
 Set A = Range(ДиапазонA)
 Set B = Range(ДиапазонB)
 Set Data = Range(ДиапазонДанных)
 On Error GoTo 0

 ' Проверяем, что диапазоны корректны
 If A Is Nothing Or B Is Nothing Or Data Is Nothing Then
 Интерполяция = CVErr(xlErrRef) ' Возвращаем ошибку ссылки
 Exit Function
 End If

 ' Проверяем, что все значения числовые
 If Application.WorksheetFunction.Count(A) <> A.Count Or _
 Application.WorksheetFunction.Count(B) <> B.Count Or _
 Application.WorksheetFunction.Count(Data) <> Data.Count Then
 Интерполяция = CVErr(xlErrValue) ' Возвращаем ошибку значения
 Exit Function
 End If

 ' Рассчитываем целевое значение
 TargetValue = Application.WorksheetFunction.Average(F22, F24)

 ' Находим минимальное значение в A, которое больше или равно F19
 On Error Resume Next
 MinA = Application.WorksheetFunction.Min(Evaluate("IF(" & ДиапазонA & ">=" & F19 & "," & ДиапазонA & ", """")"))
 RowIndex = Application.Match(MinA, A, 0)
 On Error GoTo 0

 ' Проверяем, чтобы RowIndex был валиден
 If RowIndex <= 0 Or RowIndex > A.Rows.Count Then
 Интерполяция = CVErr(xlErrValue)
 Exit Function
 End If

 ' Находим минимальное значение в B, которое больше или равно TargetValue
 On Error Resume Next
 MinB = Application.WorksheetFunction.Min(Evaluate("IF(" & ДиапазонB & ">=" & TargetValue & "," & ДиапазонB & ", """")"))
 ColIndex = Application.Match(MinB, B, 0)
 On Error GoTo 0

 ' Проверяем, чтобы ColIndex был валиден
 If ColIndex <= 0 Or ColIndex > B.Columns.Count Then
 Интерполяция = CVErr(xlErrValue)
 Exit Function
 End If

 ' Находим максимальное значение в B, которое меньше или равно TargetValue
 On Error Resume Next
 MaxB = Application.WorksheetFunction.Max(Evaluate("IF(" & ДиапазонB & "<=" & TargetValue & "," & ДиапазонB & ", """")"))
 ColIndexMax = Application.Match(MaxB, B, 0)
 On Error GoTo 0

 ' Проверяем, чтобы ColIndexMax был валиден
 If ColIndexMax <= 0 Or ColIndexMax > B.Columns.Count Then
 Интерполяция = CVErr(xlErrValue)
 Exit Function
 End If

 ' Получаем значения для интерполяции
 Y1 = Data.Cells(RowIndex, ColIndex)
 Y2 = Data.Cells(RowIndex, ColIndexMax)

 ' Проверяем, что TargetValue находится между MinB и MaxB
 If TargetValue < MinB Or TargetValue > MaxB Then
 Интерполяция = CVErr(xlErrValue) ' Возвращаем ошибку значения
 Exit Function
 End If

 ' Интерполяция
 Интерполяция = Y1 + ((TargetValue - MinB) / (MaxB - MinB)) * (Y2 - Y1)
End Function

Option Explicit

Public Function РАЗДЕЛИТЬ(Строка As String, Индекс_начало As Long, Индекс_конец As Long) As Variant
    Const DLM = "-"
    If InStr(Строка, DLM) = 0 Then
        РАЗДЕЛИТЬ = Строка
    Else
        Dim arr As Variant
        arr = Split(Строка, DLM)
        
        ReverseIndex Индекс_начало, UBound(arr)
        ReverseIndex Индекс_конец, UBound(arr)
        
        Dim brr As Variant
        ReDim brr(Индекс_начало To Индекс_конец)
        
        Dim yb As Long
        For yb = LBound(brr) To UBound(brr)
            brr(yb) = arr(yb)
        Next
        
        РАЗДЕЛИТЬ = Join(brr, DLM)
    End If
End Function

Private Sub ReverseIndex(ind As Long, iUbo As Long)
    If ind < 0 Then
        ind = iUbo + ind + 1
    Else
        ind = ind - 1
    End If
End Sub

Private Sub Workbook_Open()
On Error Resume Next
Application.OnKey "^ч", "enstaralfgdf"
Application.OnKey "^x", "enstaralfgdf"

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnKey "^ч", ""
Application.OnKey "^x", ""
End Sub

Sub enstaralfgd() ' Поиск значений на листе
Dim Rg1 As Range, Rg2 As Range, Rg3 As Range, Rg4 As Range, FindText$, Adres$
Application.ScreenUpdating = False ' отключаем обновление экрана
FindText = "Для заказчика" ' ищем ячейки с таким текстом
    Set Rg1 = ActiveSheet.UsedRange
     
    Set Rg2 = Rg1.Find(FindText, , xlValues, xlWhole) 'Краткая запись для поиска
If Not Rg2 Is Nothing Then 'After можно не указывать
        Adres$ = Rg2.Address
        Do
        Set Rg3 = Rg2.CurrentRegion.Columns(Rg2.Column)
        For I = 1 To Rg3.Cells.Count
If Rg3.Cells(I) = "" Then
    If Rg4 Is Nothing Then Set Rg4 = Rg2.Cells(I) Else Set Rg4 = Union(Rg4, Rg2.Cells(I))
End If
        Next
            Set Rg2 = Rg1.Cells.FindNext(After:=Rg2)
        Loop Until Rg2.Address = Adres
End If
Rg4.EntireRow.Delete
End Sub