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

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

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

●今回の方式
QMCの波形がきれいなので、MAせずにそのまま
上昇波形と下降波形に分けて範囲を抽出してその範囲内のピーク位置とピーク値を得るPgmです。
波形は、1つのセンサで左右クランクのネオジ磁石を読んでます。磁石のNSを変えてあって、プラスが右クランク、マイナスが左クランクの上死点通過波形です。
EXCEL2007のXMLSMファイルです。
PM2019_PtoP_Fittingrev01

FORM1のソース部分です。
1:CSVファイルを読みこみます。QMC波形は3列目にあります。

2:PeakSearchボタンでPeakSearchしてデータ列の隣に結果を表示します。
●何故VBAを使うのかというとEXCELの関数がプログラムで自由に使えるので、面倒な統計計算が一行ですべて完成します。average,stdev,match,slope,correlなど自分でプログラムを組むと何十行にもなるものが1行で片付きますので生産性が抜群です。
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

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

levelを400にするとノイズなくピーク検出できました

●以後
クランクトルクの角度波形の上死点と位相合わせして波形の周期加工プログラムも追加します。

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です