总计列直到值，然后复制行
我有一组没有线性时间增量的数据，我想总结一下在当前和以前的采样时间（时间增量）之间的增量，直到达到15分钟或更长。 一旦达到了这一点，我想复制整个行数据在> = 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样本行到新的表格。 我会用手去做，但是我有大约10万行需要这样做，这将是非常繁琐的事情。
任何帮助将不胜感激。
我认为这可以通过一个公式来实现
=IF(H1+MINUTE(B2)>=15,0,H1+MINUTE(B2))
在ColumnH中（H1为空白）复制下来以适应过滤，以在该列中select0并复制/粘贴到新的表单中。
嗯…我以为你正在寻找一个脚本。 你可能想尝试这样的事情：
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
检查下面的代码。 下面的代码将复制时间等于或大于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