MS Excel 2010 Определите пики в наборе данных, выберите его предыдущие значения и получите график

Question

У меня есть набор данных о примерно 25500 ячеек, все они содержатся в одном столбце. У данных есть ряд пиков, которые возникают, и мне нужно идентифицировать 2-й пик (и 4-й, 6-й и т.д., Где они присутствуют). У меня есть чем рассмотреть предыдущие 200 точек данных 2-го пика (соответствующих предыдущим 20 секундам), чтобы получить диапазон данных для графика. Когда значения определены, я должен сохранить их в другом столбце и использовать в качестве ссылки для диаграммы. В настоящее время я делаю это вручную, просматривая диаграмму и используя инструмент «Поиск и поиск» в Ms Office… Здесь приведен пример файла. https://drive.google.com/open?id=0B224nfA5sDRCd3huRzlEelB4cXM Я надеюсь, что удастся найти функцию для автоматического выполнения, но я не знаю, как это сделать в Excel. Спасибо за внимание. Alessandro

Answer 1

Алессандро - просто потому, что я инженер и любитель анализа данных ...

Вы правильно разбили свою проблему на три части:

1. Определить пики
2. Переместите данные из пиковых значений на другую вкладку
3. Разместите данные на каждой вкладке

Определить пики

Идентификация пиков - это наука сама по себе, и существует множество доступных методов, а также множество бесплатных фрагментов кода.

Здесь я решил сделать это просто с помощью формул электронных таблиц. Он потребует некоторой "настройки", если / когда вы примените его к другим данным.

Ниже ячейка C3 (и заполненная) представляет собой простое обнаружение пика на основе скорости изменения переменной. tol является ссылкой на ячейку F2 и является минимальной скоростью изменения, необходимой для обнаружения пика. PkHeight является ссылкой на ячейку G2 и является минимальным значением переменной, необходимой для обнаружения пика. Их можно настроить для настройки чувствительности расчетов.

Этот расчет идентифицирует множество пиков - для фильтрации интересующих пиков необходимы дальнейшие вычисления.

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

Ниже ячейка D3 (и заполненная) устраняет последовательные пики, так что первый пик идентифицируется как "пик". LookBack - это ссылка на Cell 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 ниже делает следующее:

1. Помещает данные в массив для более быстрой обработки. Если вы измените расположение исходных данных (поместите их в разные столбцы, эту часть нужно будет изменить).
2. Определяет каждый второй пик (например, 2, 4, 6)
3. Создает или очищает рабочий лист для хранения новых данных. Часть этого использует функция WSExists . Этот код был найден здесь .
4. Извлекает 200 точек данных перед пиком в другой массив. Переменная tarRows используется для указания 200 точек данных.
5. Извлеченные данные перемещаются из массива на соответствующий рабочий лист.
6. Сюжеты сделаны.

Ниже приведен код 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 используется для управления частью "на каждой вкладке". Sub PlotPeakData - это процедура, которая генерирует отдельные графики.

Это просто, и комментарии рассказывают все это ...

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 .

Для второго пика ...

Для четвертого пика ...

Для шестого пика ...