【VBA】时间序列拐点识别函数

Function IS_TURN_POINT(Pnt As Variant, Rng As Variant, Threshold As Double, Mode As Integer)
'IS_TURN_POINT() 函数返回时间序列中的点是否为反转点
'Pnt 待判断数据点
'Rng 时间序列数据点
'Threshold 判断是否反转的时间长度(>0整数)
'Mode 代表拐点是首先出现（1）还是反复确认（-1）

Application.Volatile True

Dim num, num_p, i, j As Double

'参数规范性检查
If Not Rng.Areas.Count = 1 Then
    IS_TURN_POINT = "区域只可选择一行或一列"
    Exit Function
End If
If Not (Pnt.Columns.Count = 1 And Pnt.Rows.Count = 1) Then
    IS_TURN_POINT = "待判断数据点只可选择一个单元格"
    Exit Function
End If
If Not (Rng.Columns.Count = 1 Or Rng.Rows.Count = 1) Then
    IS_TURN_POINT = "区域只可选择一行或一列"
    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 '时间序列数据点数量
'绝对位置转换成相对位置
If Rng.Columns.Count = 1 Then '列向量
    num_p = Pnt.Row - Rng.Row + 1
Else
    num_p = Pnt.Column - Rng.Column + 1
End If

'判断区间是否完整
If 1 <= num_p - Threshold Then
    If num >= num_p + Threshold Then
        '完整的区间
        lbd = num_p - Threshold
        ubd = num_p + Threshold
    Else
        '右缺的区间
        lbd = num_p - Threshold
        ubd = num
    End If
Else
    If num1 + num - 1 >= num_p + Threshold Then
        '左缺的区间
        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