interpolation3.vba

' xs - row, ys - row
Function Interp1DRow(xs As Range, ys As Range, x As Double)
Dim i As Integer
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double, d As Double
For i = 1 To xs.Columns.Count - 1
    x1 = xs.Cells(1, i).Value
    x2 = xs.Cells(1, i + 1).Value
    If x >= x1 And x <= x2 Then
        d = (x - x1) / (x2 - x1)
        y1 = ys.Cells(1, i).Value
        y2 = ys.Cells(1, i + 1).Value
        Interp1DRow = y1 + (y2 - y1) * d
        Exit Function
    End If
Next i
End Function

' xs - row, ys - column, zs - table
Function Interp2D(xs As Range, ys As Range, zs As Range, x As Double, y As Double)
Dim i As Integer, j As Integer
Dim dx As Double, dy As Double
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
Dim z1 As Double, z2 As Double, z3 As Double, z4 As Double
For i = 1 To xs.Columns.Count - 1
    x1 = xs.Cells(1, i).Value
    x2 = xs.Cells(1, i + 1).Value
    If x >= x1 And x <= x2 Then
        dx = (x - x1) / (x2 - x1)
        For j = 1 To ys.Rows.Count - 1
            y1 = ys.Cells(j, 1).Value
            y2 = ys.Cells(j + 1, 1).Value
            If y >= y1 And y <= y2 Then
                dy = (y - y1) / (y2 - y1)
                z1 = zs.Cells(j, i).Value
                z2 = zs.Cells(j, i + 1).Value
                z3 = zs.Cells(j + 1, i).Value
                z4 = zs.Cells(j + 1, i + 1).Value
                Interp2D = z1 + (z2 - z1) * dx + z3 * dy - z1 * dy + (z4 - z3) * dx * dy - (z2 - z1) * dx * dy
                Exit Function
            End If
        Next j
    End If
Next i
End Function

' xs - row, ys - column, zs - table
Function Interp2DSafe(xs As Range, ys As Range, zs As Range, x As Double, y As Double)
Dim i As Integer, j As Integer
Dim dx As Double, dy As Double
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
Dim z1 As Double, z2 As Double, z3 As Double, z4 As Double
Dim v1 As Variant, v2 As Variant, v3 As Variant, v4 As Variant
Dim ok As Boolean, n1 As Boolean, n2 As Boolean, n3 As Boolean, n4 As Boolean
Interp2DSafe = CVErr(xlErrValue)
For i = 1 To xs.Columns.Count - 1
    x1 = xs.Cells(1, i).Value
    x2 = xs.Cells(1, i + 1).Value
    If x >= x1 And x <= x2 Then
        dx = (x - x1) / (x2 - x1)
        For j = 1 To ys.Rows.Count - 1
            y1 = ys.Cells(j, 1).Value
            y2 = ys.Cells(j + 1, 1).Value
            If y >= y1 And y <= y2 Then
                dy = (y - y1) / (y2 - y1)
                ' z1 z2
                ' z3 z4
                v1 = zs.Cells(j, i).Value
                v2 = zs.Cells(j, i + 1).Value
                v3 = zs.Cells(j + 1, i).Value
                v4 = zs.Cells(j + 1, i + 1).Value
                z1 = v1
                z2 = v2
                z3 = v3
                z4 = v4
                n1 = IsNumeric(v1) And Not IsEmpty(v1)
                n2 = IsNumeric(v2) And Not IsEmpty(v2)
                n3 = IsNumeric(v3) And Not IsEmpty(v3)
                n4 = IsNumeric(v4) And Not IsEmpty(v4)
                ok = True
                ' cell corners
                If dx = 0 And dy = 0 Then
                    ok = n1
                ElseIf dx = 1 And dy = 0 Then
                    ok = n2
                ElseIf dx = 0 And dy = 1 Then
                    ok = n3
                ElseIf dx = 1 And dy = 1 Then
                    ok = n4
                End If
                ' cell borders
                If dy = 0 And dx > 0 And dx < 1 Then
                    ok = n1 And n2
                ElseIf dx = 0 And dy > 0 And dy < 1 Then
                    ok = n1 And n3
                ElseIf dx = 1 And dy > 0 And dy < 1 Then
                    ok = n2 And n4
                ElseIf dy = 1 And dx > 0 And dx < 1 Then
                    ok = n3 And n4
                End If
                ' inside cell
                If dx > 0 And dx < 1 And dy > 0 And dy < 1 Then
                    ok = n And n2 And n3 And n4
                End If
                If ok Then
                    Interp2DSafe = z1 + (z2 - z1) * dx + z3 * dy - z1 * dy + (z4 - z3) * dx * dy - (z2 - z1) * dx * dy
                End If
                Exit Function
            End If
        Next j
    End If
Next i
End Function