【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

最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 215,723评论 6 498
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 92,003评论 3 391
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 161,512评论 0 351
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 57,825评论 1 290
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 66,874评论 6 388
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 50,841评论 1 295
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 39,812评论 3 416
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 38,582评论 0 271
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 45,033评论 1 308
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 37,309评论 2 331
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 39,450评论 1 345
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 35,158评论 5 341
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 40,789评论 3 325
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 31,409评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,609评论 1 268
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 47,440评论 2 368
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 44,357评论 2 352

推荐阅读更多精彩内容