Hàm nội suy 1 chiều và 2 chiều

Liên hệ QC
Mình là dân kỹ thật nên sử dụng nội suy từ rất lâu (từ năm 1998) nên cũng đã viết ra hàm nội suy để dùng riêng. Cũng phải qua thực tế sử dụng rất nhiều lần mới viết được một hàm ưng ý (vì trong lĩnh vực kỹ thuật rất cần sự chính xác và tin cậy), tiện đây xin giới thiệu để các bạn tham khảo:
' One Directions Interpolate Function
' Author : Dang Vu Tuan
'
Function NS(table_array, Lookup_value)
Dim NumRows As Integer, i As Integer
Dim Max, Min
Dim Range1 As Range, Range2 As Range

NumRows = table_array.Rows.Count
Set Range1 = table_array.Columns(1)
Set Range2 = table_array.Columns(2)
' check for case if val = last value in range1
If Lookup_value = Range1.Cells(NumRows) Then
NS = Range2.Cells(NumRows)
Exit Function
End If
' Get Max and Min
Max = Range1.Cells(1)
Min = Range1.Cells(1)
For i = 1 To NumRows
If Max <= Range1.Cells(i) Then Max = Range1.Cells(i)
If Min >= Range1.Cells(i) Then Min = Range1.Cells(i)
Next i
' Return an error if lookup_value is not within range1
If Lookup_value > Max Or Lookup_value < Min Then
NS = "Out of range" 'Evaluate("NA()")
Exit Function
End If
' Do linear interpolation
For i = 1 To NumRows - 1
If (Lookup_value >= Range1.Cells(i) And Lookup_value <= Range1.Cells(i + 1)) Or (Lookup_value <= Range1.Cells(i) And Lookup_value >= Range1.Cells(i + 1)) Then
If (Range1.Cells(i) - Range1.Cells(i + 1)) <> 0 Then
NS = (Range2.Cells(i + 1) + (Range2.Cells(i) - Range2.Cells(i + 1)) * (Lookup_value - Range1.Cells(i + 1)) / (Range1.Cells(i) - Range1.Cells(i + 1)))
Else
NS = Range2.Cells(i)
End If
Exit Function
End If
Next i
End Function



Và đây là hàm nội suy hai chiều:

' Two Directions Interpolate Function
' Author : Dang Vu Tuan
'
Function NS2(Data_Range As Range, x, y)
Dim A(), xMax, yMax, xMin, yMin
Dim Nx, Ny, i, J, k1, k2, k3, k4, k12, k34
'Get the data
Nx = Data_Range.Columns.Count
Ny = Data_Range.Rows.Count
ReDim A(Nx, Ny)
For i = 1 To Nx
For J = 1 To Ny
A(i, J) = Data_Range(J, i)
Next J
Next i
'Check data
xMax = A(2, 1)
xMin = A(2, 1)
For i = 2 To Nx
If xMax < A(i, 1) Then xMax = A(i, 1)
If xMin > A(i, 1) Then xMin = A(i, 1)
Next i
yMax = A(1, 2)
yMin = A(1, 2)
For J = 2 To Ny
If yMax < A(1, J) Then yMax = A(1, J)
If yMin > A(1, J) Then yMin = A(1, J)
Next J
If x < xMin Or x > xMax Or y < yMin Or y > yMax Then
NS2 = "Out of range"
Exit Function
End If
'Do linear interpolation
For i = 2 To Nx - 1
If (A(i, 1) <= x And x <= A(i + 1, 1)) Or (A(i, 1) >= x And x >= A(i + 1, 1)) Then
For J = 2 To Ny - 1
If (A(1, J) <= y And y <= A(1, J + 1)) Or (A(1, J) >= y And y >= A(1, J + 1)) Then
k1 = A(i, J)
k2 = A(i + 1, J)
k3 = A(i, J + 1)
k4 = A(i + 1, J + 1)
If (A(i + 1, 1) - A(i, 1)) = 0 Then
k12 = k1
k34 = k3
Else
k12 = k1 + (k2 - k1) * (x - A(i, 1)) / (A(i + 1, 1) - A(i, 1))
k34 = k3 + (k4 - k3) * (x - A(i, 1)) / (A(i + 1, 1) - A(i, 1))
End If
If (A(1, J + 1) - A(1, J)) = 0 Then
NS2 = k12
Else
NS2 = k12 + (k34 - k12) * (y - A(1, J)) / (A(1, J + 1) - A(1, J))
End If
Exit Function
End If
Next J
End If
Next i
End Function



Hai hàm trên mình viết để dễ theo dõi nên thực sự còn có thể compact được hơn nữa.

E chỉ biết đọc thôi, hông bít viết, e thấy dễ hiểu với ai cần bắt chước làm, but hơi bị dài, đặc biệt là ở ns1c
E thấy có ng viết cái code này nè, ngắn gọn đơn giản lắm
Function NSTT(xnew, xx, yy)
For i = 1 To xx.Count
If xx(i) > xnew Then
Exit For
End If
Next i
NSTT = (xnew - xx(i - 1)) / (xx(i) - xx(i - 1)) * (yy(i) - yy(i - 1)) + yy(i - 1)
End Function
Vì ns1c chỉ cần cho i chạy tới khi giá trị x(i)>xnew (là giá trị tra), là ta đã có thể nội suy đc rồi
Đấy là ý kiến của e, có gì sai sót pác thông cảm
 
E chỉ biết đọc thôi, hông bít viết, e thấy dễ hiểu với ai cần bắt chước làm, but hơi bị dài, đặc biệt là ở ns1c
E thấy có ng viết cái code này nè, ngắn gọn đơn giản lắm
Function NSTT(xnew, xx, yy)
For i = 1 To xx.Count
If xx(i) > xnew Then
Exit For
End If
Next i
NSTT = (xnew - xx(i - 1)) / (xx(i) - xx(i - 1)) * (yy(i) - yy(i - 1)) + yy(i - 1)
End Function
Vì ns1c chỉ cần cho i chạy tới khi giá trị x(i)>xnew (là giá trị tra), là ta đã có thể nội suy đc rồi
Đấy là ý kiến của e, có gì sai sót pác thông cảm

Đúng là bản chất của hàm này chỉ cần như vậy, tuy nhiên là cần phải bẫy lỗi xảy ra trong quá trình sử dụng nên mới phải dài dòng như thế, VD điều gì sẽ xẩy ra khi sử dụng mã trên mà xx(i)=xx(i+1) hoặc yy(i)=yy(i+1)?
 
con nhà nghèo viết như vậy thì làm sao mà biết cột nào vào cột nào mà nhập số liệu để nội suy ra chứ.hic.nhung dù sao cũng cảm ơn rất nhiều
 
minh tai ve mà không sử dụng được. Mình sửa số khác vào là báo lỗi. Bạn có thể giải thích tại sao không?
 
em mới học VBA, mọi người xem file em viết 2 hàm này rồi cho em ý kiến để em hoàn thiện hơn, Thanks
đồng chí ơi sao ko gọp hai cái vào một đi cho rồi sao phải chia ra hai cái làm gì
với lại khi mà tôi khi tôi đánh noisuy2($C$3:$F$10,6,0) thì có loi value bạn thủ làm theo goi y cua tui coi. đã là nội suy thì làm một phát ra luôn chứ cần gì một chiều 2 chiều
 
phai nội suy của anh connhangheo hay lắm nhưng sao bảng nội suy của em trên 30 dòng thì không nội suy dược? có cách nào khắc phục không?
 
Lần chỉnh sửa cuối:
''=noisuyc(IF(C18<3;3;IF(C18>400;400;C18));'1-P. Luc'!$A$160:$D$178;IF($D$9="A";2; IF($D$9="B";3;4)))'' ai biết hàm này là như thế nào ko. mình có file tính có hàm này mà ko biết ý nghĩa sao cả. ai biết có thể trả lời cho mình qua địa chỉ mail quythienx1.bkdn@gmail.com . Mình cảm ơn rất nhiều!!!!
 
''=noisuyc(IF(C18<3;3;IF(C18>400;400;C18));'1-P. Luc'!$A$160:$D$178;IF($D$9="A";2; IF($D$9="B";3;4)))'' ai biết hàm này là như thế nào ko. mình có file tính có hàm này mà ko biết ý nghĩa sao cả. ai biết có thể trả lời cho mình qua địa chỉ mail quythienx1.bkdn@gmail.com . Mình cảm ơn rất nhiều!!!!
Hàm noisuyc trong công thức của bạn là hàm tự tạo. Bạn gửi file lên thử xem. Có thể dịch ngược từ hàm ra cách tính.
 
các bác nào biết file có tên là noisuyy không? help em với
 
19-11-2011 11-28-48 SA.png
Mình copy đoạn mã code cua ban " CONNHANGHEO" vào file excel 2003 => nhập hàm thì máy báo như vậy, Nhờ bạn giúp, Mình cần gấp
 
Lần chỉnh sửa cuối:
Vấn đề hàm nội suy này trong diễn đàn có nhiều rồi, các bạn tìm kiếm trên google sẽ thấy rất nhiều đơn cử một số hàm như sau:

PHP:
Function TraBang2Chieu(ByVal Hang, ByVal Cot, VungChon As Range)
'PMXD'
  Dim i As Long, j As Long
  Dim TangAnPha
  Dim NoiSuy1 As Double, NoiSuy2 As Double
  
  For i = 1 To UBound(VungChon.Value, 2)   ' Theo phuong ngang
    If Hang = VungChon(1, i) Then
      For j = 1 To UBound(VungChon.Value, 1) - 1
        If (Cot - VungChon(j, 1)) * (Cot - VungChon(j + 1, 1)) <= 0 Then
          TangAnPha = (VungChon(j + 1, i) - VungChon(j, i)) / (VungChon(j + 1, 1) - VungChon(j, 1))
          TraBang2Chieu = VungChon(j, i) + (Cot - VungChon(j, 1)) * TangAnPha
          GoTo Thoat:
        End If
      Next j
    ElseIf (Hang - VungChon(1, i)) * (Hang - VungChon(1, i + 1)) < 0 Then
      For j = 1 To UBound(VungChon.Value, 1) - 1
        If (Cot - VungChon(j, 1)) * (Cot - VungChon(j + 1, 1)) < 0 Then
          TangAnPha = (VungChon(j, i + 1) - VungChon(j, i)) / (VungChon(1, i + 1) - VungChon(1, i))
          NoiSuy1 = VungChon(j, i) + (Hang - VungChon(1, i)) * TangAnPha
          
          TangAnPha = (VungChon(j + 1, i + 1) - VungChon(j + 1, i)) / (VungChon(1, i + 1) - VungChon(1, i))
          NoiSuy2 = VungChon(j + 1, i) + (Hang - VungChon(1, i)) * TangAnPha
          
          TangAnPha = (NoiSuy2 - NoiSuy1) / (VungChon(j + 1, 1) - VungChon(j, 1))
          TraBang2Chieu = NoiSuy1 + (Cot - VungChon(j, 1)) * TangAnPha
          GoTo Thoat:
        End If
      Next j
    End If
  Next i
  
Thoat:
  'TraBang = UBound(VungChon.Value, 2)
End Function

PHP:
Function Noisuy(Hang, Cot As Double, ByVal bangns As Range) As Double
' Ham sau cho phep noi suy ca bang mot chieu va hai chieu CNPM
    Dim Tg1, Tg2, Delta As Double
    Dim m As Long ' so hang
    Dim n As Long ' so cot
    Dim i, j As Long
    Dim Found As Boolean

    n = bangns.Columns.Count
    m = bangns.Rows.Count          
    Found = False
    For j = 1 To n
    Bangns(m + 1, j) = Bangns(m, j)
    Next j
    For i = 1 To m
       Bangns(i, n + 1) = Bangns(i, n)
    Next i

    ' bay gio chung ta co mot mang hai chieu kich thuoc m x n

    For j = 2 To n - 1
    If (bangns(1, j) <= Cot) And (bangns(1, j + 1) >= Cot) Then
        Delta = (Cot - bangns(1, j)) / (bangns(1, j + 1) - bangns(1, j))
        Found = True
      
        Exit For
    End If
    Next j
    
    If Not Found Then
        MsgBox ("So noi suy nam ngoai Hang cua BangNS")      
        End
    End If
    
    For i = 2 To m - 1
    If (bangns(i, 1) <= Hang) And (bangns(i + 1, 1) >= Hang) Then
        Tg1 = bangns(i, j) + (bangns(i, j + 1) - bangns(i, j)) * Delta
        Tg2 = bangns(i + 1, j) + (bangns(i + 1, j + 1) - bangns(i + 1, j)) * Delta
        Delta = (Hang - bangns(i, 1)) / (bangns(i + 1, 1) - bangns(i, 1))
        Noisuy = Tg1 + (Tg2 - Tg1) * Delta
        Found = True
        Exit For
    End If
    Next i
    
    If Not Found Then
        MsgBox ("So noi suy nam ngoai cot cua BangNS")        
        End
    End If
            
    
End Function

PHP:
Function noisuy(ByVal r As Range, ByVal hang As Double, ByVal cot As Double) As Variant
Dim i, j, h1, h2, co1, co2 As Integer
Dim ns1, ns2 As Double
If hang = r(r.Rows.Count, 1) And cot = r(1, r.Columns.Count) Then
noisuy = r(r.Rows.Count, r.Columns.Count)
 Exit Function
 
ElseIf hang = r(r.Rows.Count, 1) Then
For j = 2 To r.Columns.Count - 1
    If cot >= r(1, j) And cot < r(1, j + 1) Then
        co1 = j
        co2 = j + 1
        Exit For
    End If
Next
noisuy = ns(r(1, co1), r(1, co2), cot, r(r.Rows.Count, co1), r(r.Rows.Count, co2))
ElseIf cot = r(1, r.Columns.Count) Then
For i = 2 To r.Rows.Count - 1
    If hang >= r(i, 1) And hang < r(i + 1, 1) Then
        h1 = i
        h2 = i + 1
        Exit For
    End If
Next
noisuy = ns(r(h1, 1), r(h2, 1), hang, r(h1, r.Columns.Count), r(h2, r.Columns.Count))
Else
For i = 2 To r.Rows.Count - 1
    If hang >= r(i, 1) And hang < r(i + 1, 1) Then
        h1 = i
        h2 = i + 1
        Exit For
    End If
Next
For j = 2 To r.Columns.Count - 1
    If cot >= r(1, j) And cot < r(1, j + 1) Then
        co1 = j
        co2 = j + 1
        Exit For
    End If
Next
ns1 = ns(r(h1, 1), r(h2, 1), hang, r(h1, co1), r(h2, co1))
ns2 = ns(r(h1, 1), r(h2, 1), hang, r(h1, co2), r(h2, co2))
noisuy = ns(r(1, co1), r(1, co2), cot, ns1, ns2)
End If
End Function

PHP:
Function ns(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal x As Double, ByVal y As Double) 
''Laulemroi va toi
As Double
ns = x + (y - x) * (c - a) / (b - a)
End Function


Function finds(ByVal r As Range, ByVal hang As Double, ByVal cot As Double) As Variant
Dim h1, h2, co1, co2 As Integer
Dim ns1, ns2 As Double
Dim r1, r2 As Range
Set r1 = r.Rows(1): Set r2 = r.Columns(1)
Dim Fn As WorksheetFunction
Set Fn = Application.WorksheetFunction
On Error Resume Next
If hang < r(2, 1) Or hang > r(r.Rows.Count, 1) Or cot < r(1, 2) Or cot > r(1, r.Columns.Count) Then
    finds = "Out Range": Exit Function
Else
h1 = Fn.Match(hang, r2): h2 = h1 + 1
co1 = Fn.Match(cot, r1): co2 = co1 + 1
ns1 = ns(r(h1, 1), r(h2, 1), hang, r(h1, co1), r(h2, co1))
ns2 = ns(r(h1, 1), r(h2, 1), hang, r(h1, co2), r(h2, co2))
finds = ns(r(1, co1), r(1, co2), cot, ns1, ns2)
End If
End Function


Tuy nhiên nếu dùng thêm hàm index và match có lẽ nhẹ nhàng hơn nhiều hàm if!
 
Lần chỉnh sửa cuối:
hic, sao minh down về nhưng ko thể dùng đc hàm của bạn, nó cứ báo lỗi NAME. bạn nào có thể giúp mình đc ko? Cảm ơn nhiều :D
 
hic, sao minh down về nhưng ko thể dùng đc hàm của bạn, nó cứ báo lỗi NAME. bạn nào có thể giúp mình đc ko? Cảm ơn nhiều :D
Có khi nào chương trình diệt VIRUS trong máy bạn nó xơi tái cái hạm tự tạo í rồi cũng nên! Đang đói mà!
 
Tui ko chạy được code nào hết...sao kì vậy...
 
Làm sao để add hàm macro đó vào bạn.Thanks
 
Quan sát dòng lệnh 9 & 10 mình thấy còn có thể rút gọn thêm (về cách viết) để đỡ rườm rà. Đó là tính trước 2 biểu thức, như sau
Tính trước cho y2: tại phần sau của dòng lệnh 3 sẽ là
y2 = Rng.Offset(, 1) - y1
Tương tự như vậy, tại phần sau của dòng lệnh 7 sẽ là:
a12 = Cells(Clls.Row, Rng.Column + 1) - a11
& tại phần sau của dòng lệnh 8 là:
a22 = Cells(Clls.Row + 1, Rng.Column + 1) - a12
cảm ơn bác rất nhiều ....... em tin tưởng hoàn toàn vào bác :D
 
tai sao khi copy đoạn code vao thi khi dùng lai không được vậy mọi người
 
không dùng được là không dùng được thế nào chứ. bạn phải nói rõ ra mọi người mới giúp được chứ ( nến bạn muốn biết thêm thì hỏi Châu Quang Phúc cd09b. hehe chắc bạn biết thằng này. nó cũng rành Vba lắm)
 
Có ai biết đổi ngược lại hàng và cột ko giúp mình với. Các hàm 1 chiều của các bạn viết thì toàn là tra theo hàng, giờ mình có bảng tra theo cột thì phải làm sao? Ví dụ:
1 3 5 7
8 6.5 4 2
Thanks các bạn!
 
Web KT
Back
Top Bottom