半周期积分_excel数据VBA处理

数据形式：两列数据，时间，Y值。

实现功能：从Y值中找到极值，再找到正负相间的第二次极值（第二次的极值中间相隔了多个原始极值点）。然后以第二次的极值点为隔点，从第一个数据积分（梯形面积），累积积分，直至积分到了下一个极值点清零。

容易忽视：极值点的条件，凸凹点都得有；做大小关系时的精度，使用double，否则可能比较失败。

Sub 正负极值点积分()    
    Dim data_long As Long '数据行数长度
    Dim i As Long
    Dim j As Long
    Dim num_Array As Long '第几个极值点
    Dim Y_peakArray(1 To 107287) '原始极值点
    Dim rownum_peakArray(1 To 107286) '原始极值点所在行数
    Dim range_peak(0 To 250000) As Long '第二次极值点间隔距离
    Dim test As Long
    
    Dim k As Long
    Dim a As Double
    Dim b As Double
    Dim c As Double
    Dim sum As Double
    
    num_Array = 1
    sum = 0
    data_long = 107286
    test = 1
      
    Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动
    Application.DisplayAlerts = False
    
    '寻找极值点
    For i = 2 To data_long - 1
        a = Sheet1.Range("b" & i - 1)
        b = Sheet1.Range("b" & i)
        c = Sheet1.Range("b" & i + 1)
        
        If (b > a And b > c) Or (b < a And b < c) Then
            Y_peakArray(num_Array) = b
            rownum_peakArray(num_Array) = i
            num_Array = num_Array + 1 '极值点个数=num_Array-1

'            测试，查看极值分布
'            Sheet2.Range("a" & test) = b
'            test = test + 1
        End If
            
    Next i
    
    '寻找正负相间极值点
    m = 0
    range_peak(0) = 0
    i = 2
    k = 1
    
    Do While i <= data_long '满足则执行,条件利用率太低,有待改进！
        Do While Y_peakArray(k) * Y_peakArray(i) < 0 'k-i对应于极值点的行数差
            range_peak(m + 1) = rownum_peakArray(i) - rownum_peakArray(k) '从第一个极值点出发，行数相减，第一个间距：range_peak(1)，对应于初始数据的行数差
            m = m + 1
            k = i
        Loop
        i = i + 1 'i是累加的，从每个间隔的极值点+1开始走
    Loop
          
     '计算正负极值点积分
     'm=总共的极值点-1
     
    '开头数据
    i = rownum_peakArray(1)
    j = 1
    For n = j To i - 1 Step 1 '实际运算到了i-1，但最后 n=i
        sum = (Sheet1.Range("b" & n) + Sheet1.Range("b" & n + 1)) * (Sheet1.Range("a" & n + 1) - Sheet1.Range("a" & n)) / 2 + sum
        Sheet1.Range("c" & n) = sum
    Next n
    sum = 0
    j = i
    
    '中间数据
    'i = rownum_peakArray(1)
    For num_Array = 1 To m '有m个间隔
        i = range_peak(num_Array) + j
        For n = j To i - 1 Step 1 '实际运算到了i-1，但最后 n=i
            sum = (Sheet1.Range("b" & n) + Sheet1.Range("b" & n + 1)) * (Sheet1.Range("a" & n + 1) - Sheet1.Range("a" & n)) / 2 + sum
            Sheet1.Range("c" & n) = sum
        Next n
        sum = 0
        j = i
    Next num_Array
        
    '计算尾部部分，应用情况：最后一个不是极值点
    For n = j To data_long - 1 '实际运算到了data_long Step，但最后 n=data_long Step+1
        sum = (Sheet1.Range("b" & n) + Sheet1.Range("b" & n + 1)) * (Sheet1.Range("a" & n + 1) - Sheet1.Range("a" & n)) / 2 + sum
        Sheet1.Range("c" & n) = sum
    Next n
    sum = 0
    
    MsgBox "积分完成!"
   
    Application.ScreenUpdating = True '解除冻结屏幕,成对使用
    Application.DisplayAlerts = True
      
End Sub