vba 如何计算图中峰值的数量？-图形分析-
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/8979752/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to count number of peaks in graph ? -graph analysis-
提问by Zalaboza
I have this curve that contains certain peaks - I want to know how to get the number of these peaks.
我有一条包含某些峰值的曲线 - 我想知道如何获得这些峰值的数量。
Sample Data:
样本数据：
0.10 76792
0.15 35578
0.20 44675
0.25 52723
0.30 27099
0.35 113931
0.40 111043
0.45 34312
0.50 101947
0.55 100824
0.60 20546
0.65 114430
0.70 113764
0.75 15713
0.80 83133
0.85 79754
0.90 17420
0.95 121094
1.00 117346
1.05 22841
1.10 95095
1.15 94999
1.20 18986
1.25 111226
1.30 106640
1.35 34781
1.40 66356
1.45 68706
1.50 21247
1.55 117604
1.60 114268
1.65 26292
1.70 88486
1.75 89841
1.80 49863
1.85 111938
The 1st column is the X values, the 2nd column is the y values.
第一列是 X 值，第二列是 y 值。
I want to write a macro or formula that tell me how many peaks in this graph.
我想写一个宏或公式来告诉我这个图中有多少个峰值。
Note: this graph is actualy ploted and exported from matlab, so if there is a way i can tell my code to do it for me from matlab it would be also great!
注意：这个图实际上是从 matlab 绘制和导出的，所以如果有一种方法可以告诉我的代码从 matlab 中为我做它也很棒！
回答by brettdj
if your data was in A1:B36then this formula
=SUMPRODUCT(--(B2:B35>B1:B34),--(B2:B35>B3:B36))
returns 11 peaks
如果您的数据在A1:B36此公式中，则
=SUMPRODUCT(--(B2:B35>B1:B34),--(B2:B35>B3:B36))
返回 11 个峰值
It checks if
它检查是否
B2is higher thanB1and B3, if so counts it as a peak- then if
B3is higher thanB2andB4, if so counts it as a peak and so on
B2高于B1和B3，如果是这样算作一个峰值- 然后 if
B3高于B2andB4，如果是，则将其视为峰值，依此类推
[Updated: VBA request added]
[更新：添加了 VBA 请求]
Sub GetMax()
Dim chr As ChartObject
Dim chrSeries As Series
Dim lngrow As Long
On Error Resume Next
Set chr = ActiveSheet.ChartObjects(1)
Set chrSeries = chr.Chart.SeriesCollection(1)
On Error GoTo 0
If chrSeries Is Nothing Then Exit Sub
For lngrow = 2 To UBound(chrSeries.Values) - 1
If chrSeries.Values(lngrow) > chrSeries.Values(lngrow - 1) Then
If chrSeries.Values(lngrow) > chrSeries.Values(lngrow + 1) Then
chrSeries.Points(lngrow).ApplyDataLabels
With chrSeries.Points(lngrow).DataLabel
.Position = xlLabelPositionCenter
.Border.Color = 1
End With
End If
End If
Next
End Sub
