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

hayho

Thành viên mới
Tham gia ngày
21 Tháng ba 2009
Bài viết
1
Được thích
2
Điểm
0
Tuổi
35
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
 

dangvutuan

Thành viên mới
Tham gia ngày
10 Tháng mười 2006
Bài viết
7
Được thích
8
Điểm
0
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)?
 

hieugalang102

Thành viên mới
Tham gia ngày
20 Tháng năm 2010
Bài viết
1
Được thích
0
Điểm
0
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
 

nvm2004

Thành viên mới
Tham gia ngày
30 Tháng mười một 2010
Bài viết
1
Được thích
0
Điểm
363
Tuổi
36
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?
 

heoxam4215

Thành viên mới
Tham gia ngày
2 Tháng ba 2011
Bài viết
6
Được thích
9
Điểm
0
Tuổi
30
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
 

haiminhstraco

Thành viên mới
Tham gia ngày
22 Tháng ba 2011
Bài viết
1
Được thích
0
Điểm
0
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:

garudb

Thành viên mới
Tham gia ngày
23 Tháng ba 2010
Bài viết
3
Được thích
0
Điểm
0
Tuổi
33
''=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!!!!
 

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,953
Được thích
9,292
Điểm
860
Nơi ở
TP.HCM
''=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.
 

tuanpvan

Thành viên mới
Tham gia ngày
6 Tháng tám 2010
Bài viết
1
Được thích
0
Điểm
351
Tuổi
36
các bác nào biết file có tên là noisuyy không? help em với
 

Phuongdong 2005

Thành viên mới
Tham gia ngày
18 Tháng ba 2009
Bài viết
7
Được thích
0
Điểm
663
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:

MicrosoftExcel

Thành viên chính thức
Tham gia ngày
21 Tháng tám 2008
Bài viết
97
Được thích
30
Điểm
670
Tuổi
40
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:

hoanh286

Thành viên mới
Tham gia ngày
16 Tháng tư 2011
Bài viết
1
Được thích
0
Điểm
0
Tuổi
31
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
 

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
11,884
Được thích
17,852
Điểm
1,860
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à!
 

kicon

Thành viên chính thức
Tham gia ngày
26 Tháng chín 2010
Bài viết
89
Được thích
16
Điểm
370
Tui ko chạy được code nào hết...sao kì vậy...
 

naulluan3388

Thành viên mới
Tham gia ngày
11 Tháng năm 2011
Bài viết
3
Được thích
1
Điểm
365
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
 

lehoangcd09a

Thành viên mới
Tham gia ngày
13 Tháng chín 2012
Bài viết
4
Được thích
0
Điểm
363
Tuổi
29
tai sao khi copy đoạn code vao thi khi dùng lai không được vậy mọi người
 

phan_huythai

Thành viên chính thức
Tham gia ngày
15 Tháng chín 2012
Bài viết
60
Được thích
1
Điểm
370
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)
 

nvh077

Thành viên mới
Tham gia ngày
12 Tháng sáu 2011
Bài viết
1
Được thích
0
Điểm
0
Tuổi
37
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!
 
Top Bottom