Hỏi về Secant Method trong VBA (1 người xem)

[eragonngo]

Code của em:

Function Secant(X0 As Double, X1 As Double) As Double​

​

' Returns the root of a function of the form F(x) = 0​

' using the Secant method.​

​

' X1 is a first guess at the value of x that solves the equation​

' X0 is a "previous" value not equal to X1.​

' This function assumes there is an external function named FS that​

' represents the function whose root is to be solved​

​

Dim X As Double 'the current guess for root being sought​

Dim Xold As Double 'previous guess for root being sought​

Dim DeltaX As Double​

Dim Iter As Integer 'iteration counter​

Const Tol = 0.00000001 'convergence tolerance​

​

Xold = X0​

X = X1​

​

'permit a maximum of 100 iterations​

For Iter = 1 To 100​

DeltaX = (X - Xold) / (1 - FS(Xold) / FS(X))​

X = X - DeltaX​

If Abs(DeltaX) < Tol Then GoTo Solution​

Next Iter​

​

MsgBox "No root found", vbExclamation, "Secant result"​

​

Solution:​

Secant = X​

​

End Function​

_____________________________________​

Function FS(X As Double, ppr As Double, Tpr As Double) As Double​

A1 = 0.3265​

A2 = -1.07​

A3 = -0.5339​

A4 = 0.01569​

A5 = -0.05165​

A6 = 0.5475​

A7 = -0.7361​

A8 = 0.1844​

A9 = 0.1056​

A10 = 0.6134​

A11 = 0.721​

pr = 0.27 * ppr / (X * Tpr)​

K1 = A1 + A2 / Tpr + A3 / (Tpr) ^ 3 + A4 / (Tpr) ^ 4 + A5 / (Tpr) ^ 5​

K2 = A6 + A7 / (Tpr) + A8 / ((Tpr) ^ 2)​

K3 = A9 * (A7 / (Tpr) + A8 / (Tpr) ^ 2)​

K4 = A10 * (1 + A11 * (pr) ^ 2) * ((pr) ^ 2) / ((Tpr) ^ 3) * Exp(-A * 11 * (pr) ^ 2)​

FS = X - (1 + K1 * pr + K2 * (pr) ^ 2 - K3 * (pr) ^ 5 + K4)​

End Function​

 

[SA_DQ]

Chắc bạn nên đưa file lên DĐ mới nhanh có câu trả lời được.

Vì 1 hiễn nhiên ít có người trong ngành như bạn.

 

[eragonngo]

Cám ơn chị Yến đã reply, đây là file và code của em. Mọi người double click vào sheet 1 trên VBA để viewcode hộ em nhé

 

[eragonngo]

Em đã cố gắng edit code của mình, nhưng vẫn bị lỗi T^T

 

[ndu96081631]

Em đã cố gắng edit code của mình, nhưng vẫn bị lỗi T^T

Xem file và code chả hiểu tính toán cái gì trong này cả

 

[ChanhTQ@]

Thứ nhất, hai hàm mà bạn viết cần để chúng nó ở Module1, không fải ở module trang tính như đang của bạn;

Theo mình bạn nên xài câu thần chú ngay từ đầu:

 Option Eplicit

thì bạn đã fát hiện ngay lỗi trên vừa nói, 1 khi bạn chạy hàm ở đâu đó như trên CS Immediate

Hàm thứ 2 của bạn có thế viết như vầy, cho thanh thoát hơn:

Function FS(X As Double, Ppr As Double, Tpr As Double) As Double
    Dim pr As Double, K1 As Double, K2 As Double, K3 As Double, K4 As Double, K5#
    
    Const A1# = 0.3265:                 Const A2# = -1.07
    Const A3# = -0.5339:                Const A4# = 0.01569
    Const A5# = -0.05165:               Const A6# = 0.5475
    Const A7# = -0.7361:                Const A8# = 0.1844
    Const A9# = 0.1056:                 Const A10# = 0.6134
    Const A11# = 0.721
    pr = 0.27 * Ppr / (X * Tpr)
    
    K1 = A1 + A2 / Tpr + A3 / (Tpr) ^ 3 + A4 / (Tpr) ^ 4 + A5 / (Tpr) ^ 5
    K2 = A6 + A7 / (Tpr) + A8 / ((Tpr) ^ 2)
    K3 = A9 * (A7 / (Tpr) + A8 / (Tpr) ^ 2)
    K4 = A10 * (1 + A11 * (pr) ^ 2) * ((pr) ^ 2) / ((Tpr) ^ 3) * Exp(-A11 * (pr) ^ 2)
    FS = X - (1 + K1 * pr + K2 * (pr) ^ 2 - K3 * (pr) ^ 5 + K4)
End Function

Còn nó tính & cho bạn kết quả gì đó hoàn toàn do bạn.

 

[Hau151978]

Bạn nên chuyển các hàm này vào module, code của bạn có 1 số lỗi:
- FS cần khai báo là function chứ không phải sub.
- Không được khai báo Dim các biến trùng tên với tham số của hàm (các biến ppr, tpr trong Secant_Factor).
- Biến X trong Secan_Factor được gán =X1 mà X1 chưa khởi tạo nên có giá trị 0. Khi truyền cho hàm FS gặp lệnh
pr = 0.27 * ppr / (X * Tpr) sẽ bị lỗi chia cho 0.
- Mình không thể sửa code do không biết phương pháp giải phương trình này, mình hay dùng phương pháp chia đôi cho đơn giản!
- Code của bạn cho dễ theo dõi:

Option Explicit
Function Secant_Factor(ppr As Double, Tpr As Double)
    ' Returns the root of a function of the form F(x) = 0
    ' using the Secant method.
    
    ' X1 is a first guess at the value of x that solves the equation
    ' X0 is a "previous" value not equal to X1.
    ' This function assumes there is an external function named FS that
    ' represents the function whose root is to be solved
    Dim X0 As Double
    Dim X1 As Double
    Dim X As Double 'the current guess for root being sought
    Dim Xold As Double 'previous guess for root being sought
    Dim DeltaX As Double
    Dim ppr As Double
    Dim Tpr As Double
    Dim Iter As Integer 'iteration counter
    Const Tol = 0.00000001 'convergence tolerance
    
    Xold = X0
    X = X1
    
    'permit a maximum of 100 iterations
    For Iter = 1 To 100
        Call FS(X, ppr, Tpr)
        DeltaX = (X - Xold) / (1 - FS(Xold, ppr, Tpr) / FS(X, ppr, Tpr))
        X = X - DeltaX
        If Abs(DeltaX) < Tol Then GoTo Solution
    Next Iter
    
    MsgBox "No root found", vbExclamation, "Secant result"
    
Solution:
    Secant_Factor = X
End Function




Public Sub FS(X As Double, ppr As Double, Tpr As Double)
    Dim pr As Double, K1 As Double, _
        K2 As Double, K3 As Double, _
        K4 As Double, K5 As Double


    
    
   Const A1 = 0.3265, _
        A2 = -1.07, _
        A3 = -0.5339, _
        A4 = 0.01569, _
        A5 = -0.05165, _
        A6 = 0.5475, _
        A7 = -0.7361, _
        A8 = 0.1844, _
        A9 = 0.1056, _
        A10 = 0.6134, _
        A11 = 0.721
        
    pr = 0.27 * ppr / (X * Tpr)
    K1 = A1 + A2 / Tpr + A3 / (Tpr) ^ 3 + A4 / (Tpr) ^ 4 + A5 / (Tpr) ^ 5
    K2 = A6 + A7 / (Tpr) + A8 / ((Tpr) ^ 2)
    K3 = A9 * (A7 / (Tpr) + A8 / (Tpr) ^ 2)
    K4 = A10 * (1 + A11 * (pr) ^ 2) * ((pr) ^ 2) / ((Tpr) ^ 3) * Exp(-A11 * (pr) ^ 2)
    FS = X - (1 + K1 * pr + K2 * (pr) ^ 2 - K3 * (pr) ^ 5 + K4)
End Sub

 

[VetMini]

Làm Iteration mà mỗi lượt lại phải tính lại hàm XOld à? Tức là mỗi lượt phải tính hàm FS tối thiểu 2 lần !!!

Nếu viêt đúng thì code chỉ nên tính FS một lượt cho mỗi vòng:

FS0 = FS(X0, ...)
For Iter = 1 To 100
FS1 = FS(X1, ...)
DeltaX = (X1 - X0) / (1 - FS0) / FS1
X1 = X1 - DeltaX
If Abs(DeltaX) < Tol Then GoTo Solution
FS0 = FS1 ' giữ để tính lại vòng kế tiếp
Next Iter