Function ПОЛИНОМ_ЗНАЧ(WorkRange As Range, CondRange As Range, CondVAL As Double)
  With Application
    LinEstVAL = .LinEst(WorkRange, .Power(CondRange, Array(1, 2, 3, 4, 5, 6)))
      a_1 = .Index(LinEstVAL, 1) * CondVAL ^ 6
      a_2 = .Index(LinEstVAL, 1, 2) * CondVAL ^ 5
      a_3 = .Index(LinEstVAL, 1, 3) * CondVAL ^ 4
      a_4 = .Index(LinEstVAL, 1, 4) * CondVAL ^ 3
      a_5 = .Index(LinEstVAL, 1, 5) * CondVAL ^ 2
      a_6 = .Index(LinEstVAL, 1, 6) * CondVAL ^ 1
      a_7 = .Index(LinEstVAL, 1, 7)
  End With
ПОЛИНОМ_ЗНАЧ = a_1 + a_2 + a_3 + a_4 + a_5 + a_6 + a_7
End Function

Function Fxy#(Tablo As Range, r#, c#)
  Dim ri&, ci&
  ri = 1 + FindIndex(Range(Tablo.Cells(2, 1), Tablo.Cells(Tablo.Rows.Count, 1)), r)
  ci = 1 + FindIndex(Range(Tablo.Cells(1, 2), Tablo.Cells(1, Tablo.Columns.Count)), c)
  Fxy = Fx(c, Tablo.Cells(1, ci), Tablo.Cells(1, ci + 1), _
  Fx(r, Tablo.Cells(ri, 1), Tablo.Cells(ri + 1, 1), Tablo.Cells(ri, ci), Tablo.Cells(ri + 1, ci)), _
  Fx(r, Tablo.Cells(ri, 1), Tablo.Cells(ri + 1, 1), Tablo.Cells(ri, ci + 1), Tablo.Cells(ri + 1, ci + 1)))
End Function
 
 
Function Fx(x#, x1#, x2#, y1#, y2#)
  Fx = y1 + (x - x1) * (y2 - y1) / (x2 - x1)
End Function
 
 
Private Function FindIndex&(rg As Range, V)
  Dim IncRg As Boolean, i&
  If rg.Cells(1) < rg.Cells(rg.Cells.Count) Then
    If V < rg.Cells(1) Then FindIndex = 1: Exit Function
    If V > rg.Cells(rg.Cells.Count) Then FindIndex = rg.Cells.Count - 1: Exit Function
    FindIndex = WorksheetFunction.Match(V, rg)
  Else
    If V > rg.Cells(1) Then FindIndex = 1: Exit Function
    If V < rg.Cells(rg.Cells.Count) Then FindIndex = rg.Cells.Count - 1: Exit Function
    FindIndex = WorksheetFunction.Match(V, rg, -1)
  End If End Function

Function FI(IL, e)

Dim TABfi As Range
Dim X As Range
Dim Y As Range

Dim i_min As Integer
Dim i_max As Integer
Dim j_min As Integer
Dim j_max As Integer

Dim x11 As Integer
Dim x12 As Integer
Dim x21 As Integer
Dim x22 As Integer

Dim a As Integer
Dim a1 As Integer
Dim a2 As Integer

Dim e_min As Integer
Dim e_max As Integer
Dim IL_min As Integer
Dim IL_max As Integer

Set TABfi = Sheets("ghost").Range("D78:R81")
Set X = Sheets("ghost").Range("D77:R77")
Set Y = Sheets("ghost").Range("C78:C81")

e_min = Application.WorksheetFunction.RoundDown(e / 0.05, 1) * 0.05
e_max = Application.WorksheetFunction.RoundUp(e / 0.05, 1) * 0.05
IL_min = Application.WorksheetFunction.RoundDown(IL / 0.25, 1) * 0.25
IL_max = Application.WorksheetFunction.RoundUp(IL / 0.25, 1) * 0.25

i_min = Application.WorksheetFunction.Match(IL_min, Y, 0)
i_max = Application.WorksheetFunction.Match(IL_max, Y, 0)
j_min = Application.WorksheetFunction.Match(e_min, X, 0)
j_max = Application.WorksheetFunction.Match(e_max, X, 0)

x11 = Application.WorksheetFunction.Index(TABfi, i_min, j_min)
x12 = Application.WorksheetFunction.Index(TABfi, i_min, j_max)
x21 = Application.WorksheetFunction.Index(TABfi, i_max, j_min)
x22 = Application.WorksheetFunction.Index(TABfi, i_max, j_max)

a1 = x11 + ((x11 - x12) / (e_min - e_max)) * (e - e_min)
a2 = x21 + ((x21 - x22) / (e_min - e_max)) * (e - e_min)
FI = a1 + ((a1 - a2) / (IL_min - IL_max)) * (IL - IL_min)

End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("Физ.свойства[[0]:[21]],Физ.свойства[[23]:[27]]")) Is Nothing Then
        If Target < 0 Then
            If MsgBox("Выделить ошибочное значение?", 4 + 32, "Обнаружено ошибочное значение") = vbNo Then
                Target = Target * 0
                Range("Физ.свойства[[5]:[27]]").Replace What:="0", Replacement:="", LookAt:=xlWhole
                With Target.Cells.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
                End With
            Else
                With Target.Cells.Interior
                .ColorIndex = 3
                .Pattern = xlSolid
                End With

            End If
        End If
    End If
End Sub

Sub ВыделитьДубликатыРазнымиЦветами()
    
    Range("Физ.свойства[0]").Select
    
    On Error Resume Next
    ' массив цветов, используемых для заливки ячеек-дубликатов
    Colors = Array(12900829, 15849925, 14408946, 14610923, 15986394, 14281213, 14277081, _
                   9944516, 14994616, 12040422, 12379352, 15921906, 14336204, 15261367, 14281213)
 
    Dim coll As New Collection, dupes As New Collection, _
        cols As New Collection, ra As Range, cell As Range, n&
    Err.Clear: Set ra = Intersect(Selection, ActiveSheet.UsedRange)
    If Err Then Exit Sub
 
    ra.Interior.ColorIndex = xlColorIndexNone: Application.ScreenUpdating = False
    For Each cell In ra.Cells ' запонимаем значение дубликатов в коллекции dupes
        Err.Clear: If Len(Trim(cell)) Then coll.Add CStr(cell.Value), CStr(cell.Value)
        If Err Then dupes.Add CStr(cell.Value), CStr(cell.Value)
    Next cell
    For i& = 1 To dupes.Count ' заполняем коллекцию cols цветами для разных дубликатов
        n = n Mod (UBound(Colors) + 1): cols.Add Colors(n), dupes(i): n = n + 1
    Next
    For Each cell In ra.Cells ' окрашиваем ячейки, если для её значения назначен цвет
        cell.EntireRow.Interior.Color = cols(CStr(cell.Value))
    Next cell
    Application.ScreenUpdating = True
End Sub