【パワーメーター2019】上死点ピーク検出Pgm出来た＜VBA＞

QMC5883で左右クランクの上死点エッジ波形のピーク検出プログラムを作りました。
検索では、いろいろ方式があったのですが、ケースバイケースで作る以外になさそうで、波形の特徴やノイズの出方などで方式は全然違ってくるみたいです。
今回は、QMC5883のクランク上死点波形でピークを検索するプログラムを作りました。

●ＷＥＢで見つけた方式
こちらは、ノイズが多い場合に有効らしく
元波形を移動平均ＭＡ２０回して元波形-ＭＡ２０波形した差分グラフから
ピーク検索範囲を抽出して元波形の最大ピークを求める方式です。
https://gijyutsu-keisan.com/excel/numcal/getpeak/getpeak_1.php#acontents3

●今回の方式
ＱＭＣの波形がきれいなので、ＭＡせずにそのまま
上昇波形と下降波形に分けて範囲を抽出してその範囲内のピーク位置とピーク値を得るＰｇｍです。
波形は、１つのセンサで左右クランクのネオジ磁石を読んでます。磁石のＮＳを変えてあって、プラスが右クランク、マイナスが左クランクの上死点通過波形です。
ＥＸＣＥＬ２００７のXMLSMファイルです。
PM2019_PtoP_Fittingrev01

ＦＯＲＭ１のソース部分です。
１：ＣＳＶファイルを読みこみます。ＱＭＣ波形は３列目にあります。

２：PeakSearchボタンでPeakSearchしてデータ列の隣に結果を表示します。
●何故ＶＢＡを使うのかというとＥＸＣＥＬの関数がプログラムで自由に使えるので、面倒な統計計算が一行ですべて完成します。average,stdev,match,slope,correlなど自分でプログラムを組むと何十行にもなるものが１行で片付きますので生産性が抜群です。
Application.WorksheetFunction.Average（範囲）で平均とれます。

Dim MaxRow As Integer
Dim MaxCol As Integer
Dim i, j, k, l As Integer
Dim Ma As Integer
Dim InnRise, InnFall As Integer
Dim QMC(1000) As Peak
Dim QMCNo As Integer
Dim Prange As RangePublic Sub CommandButton2_Click()
k = 2
chcol = 3
Peakno = 0
Ma = 20
init = 500
level = 400
InnRise = 0
InnFall = 0
Init_ave = Application.WorksheetFunction.Average(Cells(2, chcol), Cells(init, chcol))
Init_stdev = Application.WorksheetFunction.StDev(Cells(2, chcol), Cells(init, chcol))
Init_Max = Application.WorksheetFunction.Max(Cells(2, chcol), Cells(MaxRow, chcol))
Init_lMin = Application.WorksheetFunction.Min(Cells(2, chcol), Cells(MaxRow, chcol))
Cells(1, MaxCol + 1) = “Start”
Cells(1, MaxCol + 2) = “End”For i = 2 To MaxRow
‘—————–Rise———————————————
If (Cells(i, chcol) > Init_ave + level) And (InnRise = 0) Then
InnRise = 1
startK = i
Cells(k, chcol + 1) = i
End If
If (Cells(i, chcol) < Init_ave + level) And (InnRise = 1) Then
InnRise = 0
endK = i
Cells(k, chcol + 2) = i’=====================MAX ====================================
Cells(1, chcol + 3) = “PeakNo”
Cells(1, chcol + 4) = “PeakValue”
Set Prange = Range(Cells(startK, chcol), Cells(endK, chcol))
Peak_Max = Application.WorksheetFunction.Max(Prange)
Cells(k, chcol + 3) = WorksheetFunction.Match(Peak_Max, Prange, 0)
Cells(k, chcol + 4) = Peak_Max
‘=============================================================
k = k + 1
End If’——————-Fall———————————————
If (Cells(i, MaxCol) < Init_ave – level) And (InnFall = 0) Then
InnFall = 1
startK = i
Cells(k, MaxCol + 1) = i
End If
If (Cells(i, MaxCol) > Init_ave – level) And (InnFall = 1) Then
InnFall = 0
endK = i
Cells(k, MaxCol + 2) = i
‘=====================MIN ====================================
Set Prange = Range(Cells(startK, chcol), Cells(endK, chcol))
Peak_Min = Int(Application.WorksheetFunction.Min(Prange))
Cells(k, chcol + 3) = WorksheetFunction.Match(Peak_Min, Prange, 0)
Cells(k, chcol + 4) = Peak_Min
‘=============================================================
k = k + 1End If
‘——————————————————————–

Next i

‘For i = 3 To MaxRow – Ma ‘MA CAL
‘ Cells(i, MaxCol + 1) = Application.WorksheetFunction.Average(Cells(i + Ma, chcol), Cells(i, chcol)) ‘MA
‘ Cells(i, MaxCol + 2) = Cells(i + 1, MaxCol) – Cells(i, MaxCol) ‘QMCDIf’Application.WorksheetFunction.StDev(Cells(i + Ma, chcol), Cells(i, chcol)) ‘STDEV
‘ Cells(i, MaxCol + 3) = Cells(i, MaxCol + 1) – Cells(i – 1, MaxCol + 1) ‘MADIf
‘Next i

End Sub

Private Sub UserForm_Click()
End Sub
Private Sub CommandButton1_Click() ‘OPEN CSV FILE

OpenFileName = Application.GetOpenFilename(“CPLTファイル,*.csv?”)
Workbooks.Open OpenFileName
TextBox1.Value = OpenFileName
ActiveSheet.Name = “sheet1”
MaxRow = Range(“A2”).End(xlDown).Row
MaxCol = Range(“A2”).End(xlToRight).Column
ch = MaxCol
dataN = MaxRow

Worksheets.Add.Name = “sheet2”
Worksheets(“Sheet1”).Activate

End Sub

●結果
ピークの始まり検出ＬＥＶＥＬ値は現合です。２００でやると
下記のように数個エラーがでました。