Hàm nội suy 1 chiều và 2 chiều (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
connhangheo

connhangheo

Thành viên thường trực
Tham gia
18/5/07
Bài viết
214
Được thích
225
Nghề nghiệp
Sinh Viên
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
 

File đính kèm

Em không hiểu cách dùng hàm ntn?trong hàm noiuy1(D6:E13,3.5,3) cái 3.5 và 3 có nghĩa là gì?bác có thể giải thích ko?thank.
 
em xin giải thích hàm của em như sau, mọi người cho ý kiến về code giúp em
 

File đính kèm

Cảm ơn mọi người nhiều!minh không biết về VBA nhưng moi ngừoi có thể hướng dẫn cách lập biểu thứ nọi suy đo hay khong, và một bảng tính nào đó tôi muốn sử dụng nó thì làm thế nào, chẵng nhẽ mơ file nay lên rồi sửa trên đó hay sao?
cam on rất nhiều.
 
cái này bạn phải biết 1 ít về VBA
Nếu bây h bạn có 1 bảng giá trị và cần tìm giá trị nội suy trong bảng đó thì bạn sẽ làm thực hiện như sau :
bạn phải biết công thức nó như thế nào đúng không :
- Với hàm nội suy 1 chiều thì công thức như sau :
=noisuy1(bảng giá trị, giá trị cần nội suy, thứ tự của cột cần lấy giá trị nội suy)
Tham số thứ 3 (thứ tự của cột cần lấy giá trị nội suy) cần dùng trong trường hợp bảng giá trị nội suy của bạn có nhiều cột. Ví dụ khi bạn khi bạn nội suy sức chịu tải tiêu chuẩn của đất dính (trong sách Cơ Học Đất) thì giá trị cần nội suy của bạn sẽ là hệ số rỗng e, nhưng vì có nhiều giá trị độ sệt IL khác nhau (mỗi giá trị là 1 cột) nên bạn cần phải biết thứ tự của cột là bạn cần lấy giá trị nội suy.
-Với hàm nội suy 2 chiều thì công thức là thế này:
=noisuy2(bảng giá trị,giá trị cần nộ suy thứ nhất, giá trị cần nội suy thứ 2)

hàm của mình nó chưa hoàn chỉnh, trong thời gian này mình đang phải làm nhiều bài tập TKMH và chuẩn bị ôn thi nên khá bận, khi nào có thời gian nhiều hơn mình sẽ học hỏi để hoàn thiện nó tốt hơn. Ví dụ như phần bắt lỗi mình cũng chưa làm,và còn 1 số cái khác nữa. Nhưng nếu dùng tạm thì cũng vẫn ổn. Mong mọi người góp ý và cũng hoàn thiện hàm này cho anh em trong forum học hỏi. Thanks
 
Chỉnh sửa lần cuối bởi điều hành viên:
Mình đã dùng phần code của bạn, rất cám ơn :D Làm bài tập lớn cơ đất nhàn đi rất nhều!
Tuy nhiên trong quá trình làm mình thấy là khi giá trị của hàng ngang và dọc, chẳng may bằng và ứng với các giá trị của cột ngang đầu tiên và dọc đầu tiên là hàm sẽ làm việc ko ổn. Ví dụ cột dọc là 0.15 0.30 0.60; cột ngang là 0 0.25 0.5 Giá trị cần tra ở hàng ngang ứng với giá trị 0 là có vấn đề :)
Mình chưa có 1 tí kiến thức nào về VBA nên lần này may mắn tìm được bài viết của bạn, có điều thắc mắc như trên... Thank bạn :)
 
NSTT:
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

đây là hàm nội suy tuyến tính 1 chiều! có bác nào viết cho tôi hàm tìm nghiệm của 1 pt được không! Thanks!
 
Lần chỉnh sửa cuối:
Dùng hàm nội suy 2 chiều để tìm phương trình một mặt được không nhỉ?
Cụ thể là từ 1 dãy số liệu z(i)=F(x(i), y(i)
Để tìm ra dạng hàm của z=f(x,y)

Mong bạn có thể giúp mình, nếu có thể thì cả phần lý thuyết là tốt nhất. Thanks!
 
Hàm bạn connhangheo viết ổn đấy, cái khó nhất là tra vùng biên. Cứ thế phát huy --=0 !
Khai báo biến đầy đủ và chính xác (tôi thì hay nhầm và quên !$@!! ).
 
Với nội suy 1 chiều, trước.

PHP: 
Function noisuy1(vungtra As Range, X As Double, cot As Integer) As Double
    'ham noi suy 1 chieu
    Dim ktra As Boolean
    Dim i As Integer
    Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
    For i = 1 To vungtra.Cells.Count
     kiemtra = False
     If vungtra.Cells(i, 1) <= X And vungtra.Cells(i + 1, 1) >= X Then
      x1 = vungtra.Cells(i, 1): x2 = vungtra.Cells(i + 1, 1)
      y1 = vungtra.Cells(i, cot): y2 = vungtra.Cells(i + 1, cot)
      noisuy1 = (y2 - y1) * (X - x1) / (x2 - x1) + y1
      ktra = True
     End If
    Next i
    If ktra = False Then
     MsgBox "gia tri can tim ko nam trong bang tra", vbInformation
     Exit Function
    End If
End Function
Bạn còn phí phạm tài nguyên & thời giờ:
Khi tìm ra hàm rồi, nên thoát ngay vòng lặp/thoát ngay hàm, cũng OK!

Cái này mình chỉ mới suy đón thôi, cũng mạnh dạn nêu ra đây:
Nếu giá trị các cột là tăng (Giảm dần) & trong cột cũng tăng dần
có nghĩa là
1 8
2 14
7 15
thì bạn nên duyệt hàng đầu trước đề tìm trị trong ô nào > X;
Sau khi tìm ra, ta quay lại cột trước đó & tìm trong cột đó thôi.
 
Lần chỉnh sửa cuối:
Xin giới thiệu 1 cách khác để lập hàm nội suy 2 chiều

* Nhược điểm lớn nhất của hàm nội suy 2 chiều ( tại #1) là vòng lặp thứ hai lại phải duyệt toàn bộ các cells trong vùng chọn. Nhưng thực chất ta chỉ cần:
- Ở vòng lặp đầu tạm chấp nhận vì duyệt chỉ trong hàng đầu
- Vòng sau chỉ cần duyệt cột đầu của vùng dữ liệu; Vì ta đã khai báo 2 biến dạng Range (Rng & Clls), nên lưu trong nó (kèm theo 1 cách đương nhiên) các trị số cột & hàng của chúng.

PHP: 
Option Explicit
Function NoiSuyGPE(VungTra As Range, xX As Double, yY As Double) As Double
    'Ham Noi Suy 2 Chieu Tai GPE.COM (Sa_DQ)'
    Dim iW As Integer, jI As Integer
    Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
    Dim a11 As Double, a12 As Double, a21 As Double, a22 As Double
    Dim t1 As Double, t2 As Double
    
    Dim RgNg As Range, RgDoc As Range
    Dim Rng As Range, Clls As Range
    Set RgNg = VungTra.Cells(1, 1).Resize(1, VungTra.Columns.Count - 1)
    Set RgDoc = VungTra.Cells(1, 1).Resize(VungTra.Rows.Count, 1)
    
1    For Each Rng In RgNg
2      If Rng <= yY And Rng.Offset(, 1) >= yY Then
3        y1 = Rng:           y2 = Rng.Offset(, 1)
        For Each Clls In RgDoc
5        If Clls <= xX And Clls.Offset(1) >= xX Then
         x1 = Clls:         x2 = Clls.Offset(1)
        '3*'
7       a11 = Cells(Clls.Row, Rng.Column):  a12 = Cells(Clls.Row, Rng.Column + 1)
        a21 = Cells(Clls.Row + 1, Rng.Column): a22 = Cells(Clls.Row + 1, Rng.Column + 1)
9         t1 = (a12 - a11) * (yY - y1) / (y2 - y1) + a11
         t2 = (a22 - a21) * (yY - y1) / (y2 - y1) + a21
11         NoiSuyGPE = (t2 - t1) * (xX - x1) / (x2 - x1) + t1
         Exit For
13        End If
        Next Clls
15      End If
    Next Rng
17    If NoiSuyGPE = 0 Then  '!'
        msgbox "gia tri can tim ko nam trong bang tra", vbInformation
19    End If
End Function
 
connhangheo đã viết:
hàm của mình nó chưa hoàn chỉnh, trong thời gian này mình đang phải làm nhiều bài tập TKMH và chuẩn bị ôn thi nên khá bận, khi nào có thời gian nhiều hơn mình sẽ học hỏi để hoàn thiện nó tốt hơn. Ví dụ như phần bắt lỗi mình cũng chưa làm,và còn 1 số cái khác nữa. Nhưng nếu dùng tạm thì cũng vẫn ổn. Mong mọi người góp ý và cũng hoàn thiện hàm này cho anh em trong forum học hỏi. Thanks
Nhấp chuột vào đây để mở rộng...
Mình đã thử hàm của bạn rồi
Nó có một nhược điểm là tra 1 chiều cùng tăng hay thì được nhưng khi x tăng mà y giảm thì chịu thua
Mình đã nghiên cứu sửa lại
chỗ
For i = 1 To vungtra.cells.count
thành
For i = 1 To vungtra.Rows.Count
thì chạy ok
Không biết góp ý của mình có đúng hay không
Chúng ta cùng thảo luận nhé
 
connhangheo đã viết:
em xin giải thích hàm của em như sau, mọi người cho ý kiến về code giúp em
Nhấp chuột vào đây để mở rộng...
Hàm noisuy2 bạn mắc lỗi giống hàm nội suy 1 chỗ chọn giá trị vòng lặp
Mình edit lại thấy chạy tốt hơn
Bạn thử xem
 
Tự cải tiến tiếp tục:

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
Sau đó trông vô 2 biểu thức tại dòng lệnh 9 & 10 dẻ thiện cảm hơn!
, như sau:
PHP: 
                         t1 = (a12 ) * (yY - y1) / (y2 ) + a11
 t2 = (a22 ) * (yY - y1) / (y2 ) + a21

Vấn đề nữa là: Dòng lệnh 17 còn phải viết lại cho chuẩn hơn!. . . .
Sau cùng: Mình còn dư 2 biến khai báo chưa dùng (Do lịch sử để lại!)

Mã: 
Option Explicit
[B]Function NoiSuyGPE(VungTra As Range, xX As Double, yY As Double) As Double[/B]  
 [COLOR="Blue"] 'Ham Noi Suy 2 Chieu Tai GPE.COM (Sa_DQ)'[/COLOR] 
   [COLOR="Silver"]Dim iW As Integer, jI As Integer[/COLOR]
    Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
    Dim a11 As Double, a12 As Double, a21 As Double, a22 As Double
    Dim t1 As Double, t2 As Double
    
    Dim RgNg As Range, RgDoc As Range
    Dim Rng As Range, Clls As Range
    Set RgNg = VungTra.Cells(1, 1).Resize(1, VungTra.Columns.Count - 1)
    Set RgDoc = VungTra.Cells(1, 1).Resize(VungTra.Rows.Count, 1)
    
1    For Each Rng In RgNg
2      If Rng <= yY And Rng.Offset(, 1) >= yY Then
3        y1 = Rng:         [COLOR="Silver"]  y2 = Rng.Offset(, 1)[/COLOR]  
      For Each Clls In RgDoc
5        If Clls <= xX And Clls.Offset(1) >= xX Then
         x1 = Clls:         x2 = Clls.Offset(1)
        '3*'
7       a11 = Cells(Clls.Row, Rng.Column):  [COLOR="silver"]a12 = Cells(Clls.Row, Rng.Column + 1)[/COLOR]       
       a21 = Cells(Clls.Row + 1, Rng.Column): [COLOR="silver"]a22 = Cells(Clls.Row + 1, Rng.Column + 1)[/COLOR]
9        [COLOR="silver"] t1 = (a12 - a11) * (yY - y1) / (y2 - y1) + a11
         t2 = (a22 - a21) * (yY - y1) / (y2 - y1) + a21[/COLOR]
11         NoiSuyGPE = (t2 - t1) * (xX - x1) / (x2 - x1) + t1
         Exit For
13        End If
        Next Clls
15      End If
    Next Rng
17    If NoiSuyGPE = 0 Then  '!'
        msgbox "gia tri can tim ko nam trong bang tra", vbInformation
19    End If
End Function
 
Lần chỉnh sửa cuối:
Chào bác Connhangheo!
em down cái file excel tính hàm nội suy 1 chiều và 2 chiều về tính toán!
kết quả tốt lắm
nhưng mà bác ơi! Không hiểu sao khi vùng tra nằm tại một số ô trên Work sheet thì không thực hiện được 2 hàm trên. Khi mình cop vùng tra ra chỗ khác vẫn trên work sheet đó thì lại làm được.
Kể cả khi vùng tra ok rồi thực hiện phép tính ok rồi nhưng nếu mình xóa một ô or một cột nào đó mà ko ảnh hưởng đến vùng tra đó thì hàm tính tự nhiên lại ko tính được nữa.
mình không hiểu thế là thế nào? bạn có thể giải thích cho mình và hướng dẫn mình cách giải quyết ko?
mình nghĩ do macro bị virus bởi vì khi bật file excel lên thì thấy có dòng chữ:
Macros may contain viruses!....
Mình phải làm sao đây?
giúp mình nhé!
thanks and best regards!

chào bác connhangheo!
em insert hai cái code của bác vào dùng thử thấy tốt! nhưng mà có một vấn đề là trên work sheet ý, khi vùng tra ở một ô nào đó thì không thực hiện được hai hàm đó bác ạ
còn khi em cop vùng tra ra chỗ khác vẫn trên sheet đó thì lại thực hiện được
nó như thế nên rất khó để trình bày
như thế có phải là do macros của bác bị virus ko?
hay là bị vấn đề gì? mong bác giải quyết hộ vấn đề này!
cảm ơn bác nhiều!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Đúng vậy mình cũng gặp lỗi y như trên-+*/
 
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.
 
Mình đang cần cái này rất gấp
mình đã tải file về
nhưng kô biết cách nào để đưa hàm nội suy vào bảng tính của mình được còn bảng tính của bạn thì ok
để tiện cho việc tra, mình co thể để nó ở từng SHEET của excel được kô
 
mình đã down file của ban về nhưng không dùng được, no bị lỗi #Name, chac do minh thieu cài chi đó đúng không?bạn nào help mình với, thanks alot
 
newcomer007 đã viết:
mình đã down file của ban về nhưng không dùng được, no bị lỗi #Name, chac do minh thieu cài chi đó đúng không?bạn nào help mình với, thanks alot
Nhấp chuột vào đây để mở rộng...

Bạn vào Tools\Macro\Security --> chọn Medium, sau này nếu mở file ra Excel có hỏi gì đó thì bạn phải chọn Enable Macro.
 
dangvutuan đã viết:
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.
Nhấp chuột vào đây để mở rộng...

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
 
hayho đã viết:
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
Nhấp chuột vào đây để mở rộng...

Đú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?
 
connhangheo đã viết:
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
Nhấp chuột vào đây để mở rộng...
đồ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!!!!
 
garudb đã viết:
''=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!!!!
Nhấp chuột vào đây để mở rộng...
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
Nhấp chuột vào đây để mở rộng...
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
 
SA_DQ đã viết:
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
Nhấp chuột vào đây để mở rộng...
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!
 
Cám ơn anh keeponlylove rất nhiều, nhờ anh chỉnh lại một chút để khi thay đổi các giá trị trong bảng tra thì hàm vẫn có thể chạy bình thường được
 
bác cho em hỏi la hàm ngoại suy thì như thế nào?
Em có một bản cel này, trong sheet bản tra. Chỉ khi nào x,y tăng thì mới làm được vậy; có cách giải quyết khác khi không phải lập bảng cho x, y tăng không? và em còn có 1 ô không có x mà vẫn có y thì giải quyết ra sao?
 
dangvutuan đã viết:
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.
Nhấp chuột vào đây để mở rộng...
bác ơi sao em copy về dùng mà giá trị trả lại hết =0 vậy bác
thông não em với
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

N
  • Question Question
Sự kiện keydown & textbox user form (2 người xem)
Trả lời
4
Đọc
54
nguyenduy39
N
S
Em muốn copy các dữ liệu ô họ tên đã bị gộp từ B9 đến E9. Em muốn pass sang ô B9 (sheet mới). Thank (1 người xem)
Trả lời
5
Đọc
70
LOGANWover
L
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
5
Đọc
945
nguyendang95
N
H
Chia sẻ file in Phiếu điều tra PCGD
Trả lời
0
Đọc
11
HUONGHCKT
H
S
Xin các Pro chia sẻ giúp (1 người xem)
Trả lời
5
Đọc
100
nguyen6571gpex
N
T
  • Question Question
Kết quả lọc dữ liệu từ sheet TONG HOP qua từng chi tiết
Trả lời
2
Đọc
68
Hoàng Tuấn 868
H
GPE-Trợ Lý
TALKSHOW 16 BẬT MÍ THỦ THUẬT GOOGLE SHEET: TỔNG HỢP DỮ LIỆU TỪ NHIỀU SHEET & FILE BĂNG IMPORTRANGE
Trả lời
1
Đọc
515
GPE-Trợ Lý
GPE-Trợ Lý
B
Em nhờ các bro giúp giải pháp in nhiều file ạ
Trả lời
3
Đọc
72
Hoàng Tuấn 868
H
T
  • Question Question
Code VBA tra cứu kết quả trả về mảng dữ liệu
    • Cười
Trả lời
17
Đọc
339
LOGANWover
L
HeSanbi
  • Question Question
VBScript.RegExp sẽ bị xóa khỏi Windows: thư viện Pcre2 giải pháp thay thế tối ưu (1 người xem)
    • Thích
    • Cảm ơn
Trả lời
1
Đọc
95
HeSanbi
HeSanbi
S
Xin hỏi các pro. Em muốn copy các dữ liệu ô họ tên đã bị gộp từ B9 đến E9. Em muốn pass sang ô B9 (sheet mới).
Trả lời
3
Đọc
68
samthai8017
S
T
Nhờ anh chị tìm giúp nguyên nhân không nhảy dữ liệu Pivotable
Trả lời
2
Đọc
91
thuhacoicoi
T
HeSanbi
  • Question Question
Chuyển mã VBA ứng dụng Excel 32 bit hoạt động trên cả 64bit (Hoàn toàn 0 phí) (1 người xem)
    • Thích
Trả lời
0
Đọc
70
HeSanbi
HeSanbi
T
Ctrl + Shift + 0 không dùng để unhide cột được
Trả lời
24
Đọc
22K
Oji
O
quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail. (1 người xem)
    • Thích
    • Yêu thích
Trả lời
19
Đọc
4K
Hoàng Tuấn 868
H
Gà Công Nghệ
Nhờ anh chị chuyển hộ font chữ excel
Trả lời
3
Đọc
104
HeSanbi
HeSanbi
huytamlinh
Anh Chị giúp em sửa lỗi định dạng với ạ !
Trả lời
3
Đọc
60
Hoàng Tuấn 868
H
T
  • Question Question
Xin giúp em mã lệnh tổng hợp tự động lên bảng tổng hợp!
Trả lời
1
Đọc
65
Hoàng Tuấn 868
H
V
Quản lý xuất nhập vật tư trong kho (1 người xem)
Trả lời
19
Đọc
776
LOGANWover
L
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên (1 người xem)
    • Cảm ơn
Trả lời
4
Đọc
362
phuongnam366377
phuongnam366377
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom