Copy đoạn code bên dưới :
Function INTER2D(table As Range, vrow As Double, vcol As Double)
On Error Resume Next
r = table.Rows.Count: c = table.Columns.Count: i = 2: j = 2
If (vrow > table.Cells(r, 1).Value) Or (vrow < table.Cells(2, 1).Value) _
Or (vcol > table.Cells(1, c).Value) Or (vcol < table.Cells(1, 2).Value) _
Then
result = "OUTSIDE"
Else
Do While (i < r) And (vrow > table.Cells(i + 1, 1).Value): i = i + 1: Loop
Do While (j < c) And (vcol > table.Cells(1, j + 1).Value): j = j + 1: Loop
x1 = table.Cells(1, j).Value: y1 = table.Cells(i, j).Value
x2 = table.Cells(1, j + 1).Value: y2 = table.Cells(i, j + 1).Value
c1 = (y2 - y1) / (x2 - x1) * (vcol - x1) + y1
x1 = table.Cells(1, j).Value: y1 = table.Cells(i + 1, j).Value
x2 = table.Cells(1, j + 1).Value: y2 = table.Cells(i + 1, j + 1).Value
c2 = (y2 - y1) / (x2 - x1) * (vcol - x1) + y1
x1 = table.Cells(i, 1).Value: y1 = c1
x2 = table.Cells(i + 1, 1).Value: y2 = c2
result = (y2 - y1) / (x2 - x1) * (vrow - x1) + y1
If Err.Number <> 0 Then
result = "ERROR": Err.Clear
End If
End If
INTER2D = result:
End Function
Cộng đồng thư viện hàm VBA di động - Thư viện hàm VBA lập trình sẵn - Tải về và sử dụng
Không có nhận xét nào:
Đăng nhận xét