'---------------------------------------------------------------------------------------
'
' P U R P O S E
'
' The function lin_xyzt uses linear interpolation (or extrapolation) to find the value
' z(x=x_value,y=y_value,t=t_value) from multiple tables (x, y, z) of different t values.
' Each table is arranged so that the 1st column and the 1st row contain x and y values,
' respectively. The z values are at the intersection of its x and y values.
' The program assumes x and y in each table are in ascending order.
'
' I N P U T
'
' Table = a range of cells in the worksheet that defines the multiple tables.
' row_col = a range of cells in the following format (one line for each table in Table):
' row_1, row_2, col_1, col_2, t
' where
' row_1 = starting row number of table, relative to the first cell in Table.
' row_2 = ending row number of table.
' col_1 = starting column number of table, relatve to the first cell in Table.
' col_2 = ending column number of table
' t = table values, arranged in ascending order.
' x_value = the x value where the z value is to be determined.
' y_value = the y value where the z value is to be determined.
' t_value = the t value where the z value is to be determined.
' extrapolate (optional)
' = if omitted, will return #N/A if x_value, y_value or t_value is out-of-bound.
' = "bd", will return table bounded value if x_value, y_value or t_value is out-of-bound.
' = "et", will linearly extrapolate if x_value, y_value or t_value is out-of-bound.
'
' O U T P U T
'
' lin_xyzt = the z value at (x=x_value, y=y_value, t=t_value).
' For multiple x_values or y_values, the first pair will be returned.
' If x_value, y_value or t_value is out-of-bounds, the argument extrapolate
' will determine the returned value.
'
'---------------------------------------------------------------------------------------
Function lin_xyzt(Table As Object, row_col As Object, x_value, y_value, t_value, Optional extrapolate)
Dim i, j As Integer ' counter.
Dim i1, i2 As Integer
Dim z1, z2 As Single
Dim active_all(1) As Boolean
Dim extr
Dim row_1, row_2, col_1, col_2 As Integer
Dim T As Object
Dim Table_1 As Range
Dim Table_2 As Range
If IsMissing(extrapolate) Then
extr = ""
Else
extr = LCase(extrapolate)
End If
Select Case row_col.Rows.count
Case 1 ' single table. t_value is ignored.
row_1 = row_col(1, 1)
row_2 = row_col(1, 2)
col_1 = row_col(1, 3)
col_2 = row_col(1, 4)
Set Table_1 = Range(Table.Cells(row_1, col_1), Table.Cells(row_2, col_2))
lin_xyzt = lin_xyz(Table_1, x_value, y_value, extrapolate)
Case Else
Set T = Range(row_col.Cells(1, 5), row_col.Cells(row_col.Rows.count, 5))
active_all(1) = True
Call bracket(T, t_value, i1, i2, active_all())
row_1 = row_col(i1, 1)
row_2 = row_col(i1, 2)
col_1 = row_col(i1, 3)
col_2 = row_col(i1, 4)
Set Table_1 = Range(Table.Cells(row_1, col_1), Table.Cells(row_2, col_2))
row_1 = row_col(i2, 1)
row_2 = row_col(i2, 2)
col_1 = row_col(i2, 3)
col_2 = row_col(i2, 4)
Set Table_2 = Range(Table.Cells(row_1, col_1), Table.Cells(row_2, col_2))
z1 = lin_xyz(Table_1, x_value, y_value, extrapolate)
z2 = lin_xyz(Table_2, x_value, y_value, extrapolate)
If t_value >= T(i1) And t_value <= T(i2) Then
lin_xyzt = lin_2xy(T(i1), z1, T(i2), z2, t_value)
Else
Select Case extr
Case "bd"
If t_value < T(i1) Then
lin_xyzt = z1
ElseIf t_value > T(i2) Then
lin_xyzt = z2
Else
lin_xyzt = [#N/A]
End If
Case "et"
lin_xyzt = lin_2xy(T(i1), z1, T(i2), z2, t_value)
Case Else
lin_xyzt = [#N/A]
End Select
End If
End Select
End Function
Bookmarks