Attribute VB_Name = "modMethod"
Option Explicit
'一元非線性
'x(1 To n)：自變量，n為觀測次數
'y(1 To n)：因變量，n為觀測次數
'b0：截距，計算結果
'b1：回歸系數，計算結果
'R2：擬合指數，計算結果
Public Sub LinR2(x() As Double, y() As Double, b0 As Single, b1 As Single, _
                R2 As Double)
    Dim Xa As Double, Ya As Double, Sxx As Double, Sxy As Double, Syy As Double
    Dim SSR As Double, SSE As Double
    Dim Syx2 As Double, Sb As Double, Sb2 As Double, Sx As Double
    Dim n As Integer, I As Integer
    On Error Resume Next
    n = UBound(x, 1)
    For I = 1 To n
        Xa = Xa + x(I): Ya = Ya + y(I)
    Next I
    Xa = Xa / n: Ya = Ya / n                        '平均值
    For I = 1 To n
        Sxx = Sxx + (x(I) - Xa) ^ 2
        Sxy = Sxy + (x(I) - Xa) * (y(I) - Ya)
        Syy = Syy + (y(I) - Ya) ^ 2
    Next I
    b1 = Sxy / Sxx                                  '截距
    b0 = Ya - b1 * Xa                               '回歸系數
'總方差
'Ya為因變量的平均值
    For I = 1 To n
        SSR = SSR + (Ya - b0 - b1 * x(I)) ^ 2
    Next I
'由剩余所導致的方差
'y(I)為因變量的觀測值
    For I = 1 To n
        SSE = SSE + (y(I) - b0 - b1 * x(I)) ^ 2
    Next I
'擬合指數
    R2 = 1 - SSE / SSR
End Sub

'計算函數值
Public Sub ReCul(b0 As Single, b1 As Single, K As Integer, _
        x As Double, y As Double)
'*****
    Select Case K
        Case 1
            y = b0 + b1 * x                     '線性
        Case 2
            y = b0 + b1 / x                     '雙曲線(1)
        Case 3
            y = 1 / (b0 + b1 / x)               '雙曲線(2)
        Case 4
            y = b0 + b1 * Log(x)                'X對數
        Case 5
            y = Exp(b0 + b1 * x)                'Y對數
        Case 6
            y = Exp(b0 + b1 * Log(x))           '雙對數
        Case 7
            y = 1 / (b0 + b1 * Exp(-x))         'S型
        Case 8
            y = b0 + b1 * Sqr(x)                'X平方根
        Case 9
            y = (b0 + b1 * x) ^ 2               'Y平方根
        Case 10
            y = (b0 + b1 * Sqr(x)) ^ 2          '雙平方根
    End Select
'*****
End Sub