Question

我有一组没有线性时间增量的数据，我想对当前和上一个采样时间（时间增量）之间的增量值进行求和，直到达到15分钟或更长。达到该点后，我想在＆gt; = 15分钟点复制整行数据并将其粘贴到新工作表中。在我拥有该行之后，我想在循环中继续使用相同的函数，直到它到达数据的末尾。

从本质上讲，我想为我的样本采取零星时间增量的数据，并将其转换为15分钟的样本数据（降低分辨率）。我正在使用的一些数据仅供参考。

Date+Time   Time Delta  Temp_A  Temp_Inv    DCV_In  OUT_Pwr
01/13/14 19:39  0:00:00 74.67   66.65   317.99  8845.09
01/13/14 19:40  0:01:00 74.77   66.76   317.46  8851.05
01/13/14 19:41  0:01:00 74.87   66.86   317.56  8845.09
01/13/14 19:41  0:00:00 75.01   66.97   318.51  8855.81
01/13/14 19:42  0:01:00 75.17   67.11   318.51  8846.28
01/13/14 19:43  0:01:00 75.28   67.29   318.53  8846.28
01/13/14 19:44  0:01:00 75.48   67.38   318.61  8849.86
01/13/14 19:45  0:01:00 75.58   67.51   318.77  8848.67
01/13/14 19:46  0:01:00 75.78   67.72   318.75  8845.09
01/13/14 19:47  0:01:00 75.88   67.84   318.41  8851.05
01/13/14 19:49  0:02:00 76.08   68  318.69  8853.43
01/13/14 19:50  0:01:00 76.42   68.17   318.43  8845.09
01/13/14 19:52  0:02:00 74.87   68.52   336.17  0
01/13/14 19:54  0:02:00 74.67   68.61   318.53  8852.24
01/13/14 19:56  0:02:00 75.17   68.62   318.87  8848.67
01/13/14 19:57  0:01:00 75.68   68.73   318.59  8845.09
01/13/14 19:59  0:02:00 75.99   68.84   318.53  8848.67
01/13/14 20:00  0:01:00 76.19   68.95   318.61  8848.67
01/13/14 20:02  0:02:00 76.49   69.07   318.65  8849.86
01/13/14 20:03  0:01:00 76.7    69.18   318.25  8845.09
01/13/14 20:05  0:02:00 77.01   69.3    318.93  8847.48
01/13/14 20:06  0:01:00 77.22   69.53   318.73  8847.48
01/13/14 20:08  0:02:00 77.42   69.64   317.12  8845.09
01/13/14 20:09  0:01:00 77.64   69.76   317.06  8852.24
01/13/14 20:11  0:02:00 77.94   70  317.22  8841.52
01/13/14 20:12  0:01:00 78.06   70.11   317.3   8851.05
01/13/14 20:14  0:02:00 78.28   70.35   318.79  8854.62

因此，我正在寻找的脚本将总和Time Delta列（从顶部开始），总和将达到15分钟或更长（这将发生在19:54样本），然后将复制19： 54个样本行到新表。我会手工完成，但我有大约100,000行需要执行此操作，这样做非常繁琐。

非常感谢任何帮助。

Answer 1

我认为这可以通过诸如

这样的公式来实现

=IF(H1+MINUTE(B2)>=15,0,H1+MINUTE(B2))

将ColumnH中的

（H1为空白）向下复制以适应然后过滤以选择该列中的0并复制/粘贴到新工作表中。

Answer 2

嗯......我以为你在寻找一个剧本。你可能想尝试这样的事情：

Sub copyData()
    sumDelta = 0

    Set currentCell = ActiveSheet.Range("C2")

    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    Set Destination = ws.Cells(1, 1)

    Do While Not IsEmpty(currentCell)
        sumDelta = sumDelta + currentCell.Value
        If sumDelta >= TimeValue("00:15:00") Then
            currentCell.EntireRow.Copy Destination:=Destination
            Set Destination = Destination.Offset(1, 0)
            sumDelta = 0
        End If
        Set currentCell = currentCell.Offset(1, 0)
    Loop
End Sub

Answer 3

检查下面的代码。以下代码将复制时间等于或大于15分钟的所有数据，并粘贴到另一张表中。

Sub t()

Dim NewSheet As Worksheet

Set NewSheet = ThisWorkbook.Sheets.Add

With ThisWorkbook.Sheets("sheet1")
    Set LastColumn = .Cells.Find(what:="*", after:=.Cells(Rows.Count, Columns.Count), LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByColumns, searchdirection:=xlPrevious)

    EndRow = .Range("a" & Rows.Count).End(xlUp).Row
    For Each cell In .Range("a2:a" & .Range("a" & Rows.Count).End(xlUp).Row)
        i = i + 1
            If i <> 1 Then
                    .Cells(i + 1, LastColumn.Column + 1) = cell.Value - cell.Offset(-1, 0)
                    .Cells(i + 1, LastColumn.Column + 1).NumberFormat = "hh:mm:ss"
                ElseIf i = 1 Then
                    .Cells(i + 1, LastColumn.Column + 1) = "00:00:00"
                    .Cells(i + 1, LastColumn.Column + 1).NumberFormat = "hh:mm:ss"

            End If
    Next cell

    i = 0
    j = 1
    For Each cell In .Range(.Cells(2, LastColumn.Column + 1), .Cells(EndRow, LastColumn.Column + 1))
        i = i + 1
                .Cells(i + 1, LastColumn.Column + 2) = cell.Value + cell.Offset(-1, 1)
                If Format(.Cells(i + 1, LastColumn.Column + 2), "hh:mm:ss") >= "00:15:00" Then
                j = j + 1
                cell.EntireRow.Copy
                NewSheet.Range("a" & j).PasteSpecial (xlPasteAll)
                End If
                .Cells(i + 1, LastColumn.Column + 2).NumberFormat = "hh:mm:ss"

    Next cell
    .Rows(1).Copy
    NewSheet.Range("a1").PasteSpecial (xlPasteAll)
    .Range(.Cells(1, LastColumn.Column + 1), .Cells(1, LastColumn.Column + 2)).EntireColumn.Clear
    NewSheet.Range(NewSheet.Cells(1, LastColumn.Column + 1), NewSheet.Cells(1, LastColumn.Column + 2)).EntireColumn.Clear
End With

End Sub

总和列直到值然后复制行

3 个答案: