【VBA】時間序列拐點識別函數(shù)

Function IS_TURN_POINT(Pnt As Variant, Rng As Variant, Threshold As Double, Mode As Integer)
'IS_TURN_POINT() 函數(shù)返回時間序列中的點是否為反轉(zhuǎn)點
'Pnt 待判斷數(shù)據(jù)點
'Rng 時間序列數(shù)據(jù)點
'Threshold 判斷是否反轉(zhuǎn)的時間長度(>0整數(shù))
'Mode 代表拐點是首先出現(xiàn)(1)還是反復確認(-1)

Application.Volatile True

Dim num, num_p, i, j As Double

'參數(shù)規(guī)范性檢查
If Not Rng.Areas.Count = 1 Then
    IS_TURN_POINT = "區(qū)域只可選擇一行或一列"
    Exit Function
End If
If Not (Pnt.Columns.Count = 1 And Pnt.Rows.Count = 1) Then
    IS_TURN_POINT = "待判斷數(shù)據(jù)點只可選擇一個單元格"
    Exit Function
End If
If Not (Rng.Columns.Count = 1 Or Rng.Rows.Count = 1) Then
    IS_TURN_POINT = "區(qū)域只可選擇一行或一列"
    Exit Function
End If
If Not Threshold > 0 Then
    IS_TURN_POINT = "閾值定義錯誤"
    Exit Function
End If
If Not (Mode = 1 Or Mode = -1) Then
    IS_TURN_POINT = "拐點驗證類型定義錯誤"
    Exit Function
End If

'主程序
'待判斷點為錯誤值時返回0
If IsError(Pnt) Then
    IS_TURN_POINT = 0
    Exit Function
End If

num = Rng.Count '時間序列數(shù)據(jù)點數(shù)量
'絕對位置轉(zhuǎn)換成相對位置
If Rng.Columns.Count = 1 Then '列向量
    num_p = Pnt.Row - Rng.Row + 1
Else
    num_p = Pnt.Column - Rng.Column + 1
End If

'判斷區(qū)間是否完整
If 1 <= num_p - Threshold Then
    If num >= num_p + Threshold Then
        '完整的區(qū)間
        lbd = num_p - Threshold
        ubd = num_p + Threshold
    Else
        '右缺的區(qū)間
        lbd = num_p - Threshold
        ubd = num
    End If
Else
    If num1 + num - 1 >= num_p + Threshold Then
        '左缺的區(qū)間
        lbd = 1
        ubd = num_p + Threshold
    Else
        IS_TURN_POINT = "閾值過大"
        Exit Function
    End If
End If

If Mode = 1 Then '首先確認
    '判定左邊
    j = 0
    For i = ibd To ubd
        If Not IsError(Rng(i)) Then j = j + 1
    Next i
    If j < 2 * Threshold + 1 Then
        IS_TURN_POINT = 0
        Exit Function
    End If
   
    IS_TURN_POINT = -1 '假定是低點
    For i = lbd To Application.WorksheetFunction.Max(num_p - 1, 1)
       If Not IsError(Rng(i)) Then
            If Not Rng(i) > Rng(num_p) Then
                IS_TURN_POINT = 1 '不是低點,假定是高點
                Exit For
            End If
        End If
    Next i
    
    If IS_TURN_POINT = 1 Then
        For i = lbd To Application.WorksheetFunction.Max(num_p - 1, 1)
            If Not IsError(Rng(i)) Then
                If Not Rng(i) < Rng(num_p) Then
                    IS_TURN_POINT = 0
                    Exit Function
                End If
            End If
        Next i
    End If
    
    '判定右邊
    If IS_TURN_POINT = -1 Then
        For j = num_p + 1 To ubd
            If Not IsError(Rng(j)) Then
                If Not Rng(num_p) <= Rng(j) Then
                    IS_TURN_POINT = 0
                    Exit Function
                End If
            End If
        Next j
        Exit Function
    Else
        For j = num_p + 1 To ubd
            If Not IsError(Rng(j)) Then
                If Not Rng(num_p) >= Rng(j) Then
                    IS_TURN_POINT = 0
                    Exit Function
                End If
            End If
        Next j
        Exit Function
    End If

Else '反復確認
    '判定左邊
    j = 0
    For i = ibd To ubd
        If Not IsError(Rng(i)) Then j = j + 1
    Next i
    If j < 2 * Threshold + 1 Then
        IS_TURN_POINT = 0
        Exit Function
    End If
   
    IS_TURN_POINT = -1 '假定是低點
    For i = lbd To Application.WorksheetFunction.Max(num_p - 1, 1)
       If Not IsError(Rng(i)) Then
            If Not Rng(i) >= Rng(num_p) Then
                IS_TURN_POINT = 1 '不是低點,假定是高點
                Exit For
            End If
        End If
    Next i
    
    If IS_TURN_POINT = 1 Then
        For i = lbd To Application.WorksheetFunction.Max(num_p - 1, 1)
            If Not IsError(Rng(i)) Then
                If Not Rng(i) <= Rng(num_p) Then
                    IS_TURN_POINT = 0
                    Exit Function
                End If
            End If
        Next i
    End If
    
    '判定右邊
    If IS_TURN_POINT = -1 Then
        For j = num_p + 1 To ubd
            If Not IsError(Rng(j)) Then
                If Not Rng(num_p) < Rng(j) Then
                    IS_TURN_POINT = 0
                    Exit Function
                End If
            End If
        Next j
        Exit Function
    Else
        For j = num_p + 1 To ubd
            If Not IsError(Rng(j)) Then
                If Not Rng(num_p) > Rng(j) Then
                    IS_TURN_POINT = 0
                    Exit Function
                End If
            End If
        Next j
        Exit Function
    End If
End If

End Function

最后編輯于
?著作權歸作者所有,轉(zhuǎn)載或內(nèi)容合作請聯(lián)系作者
平臺聲明:文章內(nèi)容(如有圖片或視頻亦包括在內(nèi))由作者上傳并發(fā)布,文章內(nèi)容僅代表作者本人觀點,簡書系信息發(fā)布平臺,僅提供信息存儲服務。

推薦閱讀更多精彩內(nèi)容