半週期積分_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