MS Excel 2010 识别数据集中的峰值，选择其先前的值并获取图表

Question

亚历山德罗——只是因为我是一名工程师，并且是一名分析数据的傻瓜......

您正确地将问题分解为三个部分：

识别峰值
将峰值之前的数据移至其他选项卡
绘制每个选项卡上的数据

识别峰值

峰值识别本身是一门科学，并且有许多可用的方法，以及许多免费的代码。

这里，我选择简单地使用电子表格公式。如果/当你将它应用于不同的数据时，它将需要一些“调整”。

下面，单元格C3（和向下填充）是基于变量变化率的简单峰值检测。tol是对单元格的引用F2，是检测峰值所需的最小变化率。PkHeight是对单元格的引用G2，是检测峰值所需的变量的最小值。可以调整这些以调整计算的灵敏度。

该计算确定了许多峰值 - 需要进一步计算来筛选出感兴趣的峰值。

细胞C3...=IF(AND(B3-B2>tol,B3-B4>=0,B3>PkHeight),1,0)

下面，单元格 D3（并向下填充）消除了连续的峰值，这样第一个峰值就被识别为“该”峰值。LookBack是对单元格的引用H2。它可用于调整此计算。如果在当前行中检测到峰值，并且在前几LookBack行中检测到峰值，则当前峰值将被拒绝。

细胞D3...=IF(AND(C3=1,MAX(C2:OFFSET(C2,MAX(2,ROW()-LookBack)-ROW(),0))=0),1,0)

单元格I2是 D 列的总和。——=SUM(D2:D25569)它显示我们已经确定了 6 个独特的峰值。

将峰值之前的数据移至其他选项卡

下面的 VBA 子程序执行以下操作：

将数据放入数组中以便更快地处理。如果您更改源数据的排列（将其放入不同的列中），则需要修改此部分。
识别每个第二个峰值（例如 2、4、6）
创建或清理工作表以保存新数据。这部分使用函数WSExists。此代码可在此处找到。
将峰值之前的 200 个数据点提取到另一个数组中。变量tarRows用于指定 200 个数据点。
提取的数据从数组移动到相关的工作表。
情节已制定。

以下是ExtractPeakData代码...

Sub ExtractPeakData()
Dim srcSht As Worksheet, tarSht As Worksheet
Dim srcRng As Range, tarRng As Range
Dim PeakRng As Range
Dim tarCht As ChartObject
Dim PeakArr() As Variant, srcArr() As Variant, tarArr() As Variant
Dim tarShtName As String
Dim lstRow As Long
Dim PeakCnt As Long, tarRows As Long
Dim iLoop As Long, jLoop As Long, kLoop As Long
Dim loopStart As Long

' initialize

Set srcSht = ThisWorkbook.Worksheets("Data")
lstRow = srcSht.Range("A1").End(xlDown).Row

Set srcRng = srcSht.Range(srcSht.Cells(1, 1), srcSht.Cells(lstRow, 2))
Set PeakRng = srcSht.Range(srcSht.Cells(1, 4), srcSht.Cells(lstRow, 4))

srcArr = srcRng.Value
PeakArr = PeakRng.Value
PeakCnt = 0
tarRows = 200 + 1 ' one row for the header


' Find the even numbered peaks
For iLoop = LBound(PeakArr, 1) To UBound(PeakArr, 1)
    If PeakArr(iLoop, 1) = 1 Then PeakCnt = PeakCnt + 1
    If PeakArr(iLoop, 1) = 1 And PeakCnt Mod 2 = 0 Then

' Create or clean up a sheet for the data and chart
        tarShtName = "PeakData" & PeakCnt
        If Not WSExists(tarShtName) Then
            Set tarSht = ThisWorkbook.Worksheets.Add
            tarSht.Name = tarShtName
        Else
            Set tarSht = ThisWorkbook.Worksheets(tarShtName)
            tarSht.Cells.Clear
            For Each tarCht In tarSht.ChartObjects
                tarCht.Delete
            Next tarCht
        End If

        loopStart = iLoop - tarRows
        If loopStart < 2 Then loopStart = 2
        ReDim tarArr(1 To iLoop - loopStart, 1 To UBound(srcArr, 2))

' put the header row in
        For kLoop = 1 To UBound(tarArr, 2)
            tarArr(1, kLoop) = srcArr(1, kLoop)
        Next kLoop
' put the data rows in
        For jLoop = loopStart + 1 To iLoop - 1
            For kLoop = 1 To UBound(tarArr, 2)
                tarArr(jLoop - loopStart + 1, kLoop) = srcArr(jLoop, kLoop)
            Next kLoop
        Next jLoop
        Set tarRng = tarSht.Range(tarSht.Cells(1, 1), tarSht.Cells(tarRows, 2))
        tarRng.Value = tarArr

' plot the data on each target sheet
        PlotPeakData (tarShtName)
    End If
Next iLoop

' clean up
Erase PeakArr
Erase tarArr
Erase srcArr
Set tarRng = Nothing
Set srcRng = Nothing
Set tarSht = Nothing
Set srcSht = Nothing

End Sub

...下面是WSExistss代码...

Function WSExists(myStr As String) As Boolean
' From https://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-exists
Dim ws As Worksheet
  WSExists = False
  For Each ws In Worksheets
    If myStr = ws.Name Then
      WSExists = True
      Exit Function
    End If
  Next ws
End Function

绘制每个选项卡上的数据

循环ExtractPeakData用于管理“每个选项卡上”部分。 SubPlotPeakData是生成单独图表的例程。

这很简单，评论说明了一切......

Sub PlotPeakData(PkDataName As String)
Dim PkDataSht As Worksheet
Dim PkDataCht As ChartObject
Dim lstRow As Long

' initial
If Not WSExists(PkDataName) Then Exit Sub
Set PkDataSht = Worksheets(PkDataName)
lstRow = PkDataSht.Range("A1").End(xlDown).Row

' create the chart and position it
Set PkDataCht = PkDataSht.ChartObjects.Add( _
        PkDataSht.Range("E2").Left, _
        PkDataSht.Range("E2").Top, _
        PkDataSht.Range("M2").Left - PkDataSht.Range("E2").Left, _
        PkDataSht.Range("E17").Top - PkDataSht.Range("E2").Top)

With PkDataCht.Chart
' add the data to it
    .ChartType = xlXYScatterLinesNoMarkers
    .SeriesCollection.NewSeries
    .SeriesCollection(1).Name = PkDataSht.Range("B1")
    .SeriesCollection(1).XValues = PkDataSht.Range("A2:A" & lstRow)
    .SeriesCollection(1).Values = PkDataSht.Range("B2:B" & lstRow)
' add the titles to it
    .HasTitle = True
    .ChartTitle.Characters.Text = PkDataSht.Range("B1").Value
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = PkDataSht.Range("A1").Value
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = PkDataSht.Range("B1")
    .Axes(xlCategory).HasMajorGridlines = True
' do the gridlines
    .Axes(xlCategory).HasMinorGridlines = False
    .Axes(xlValue).HasMajorGridlines = True
    .Axes(xlValue).HasMinorGridlines = False
    .HasLegend = False
' do other formatting here ...
End With

End Sub

结果

下面是运行后的屏幕截图ExtractPeakData。

对于第二座高峰……

对于第四座高峰……

对于第六座山峰来说……

Answer 1