總和列直到值，然後複製行

我有一組數據沒有線性時間增量，我想總結一個列，它取當前和前一個採樣時間（時間差）之間的差值，直到達到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

所以我要尋找會總結的時間增量列（從頂部開始）腳本，將在總和達到15分鐘或更長（這將在19:54樣本發生），然後將將19:54樣品行復制到新工作表。我會手工做，但我有大約100,000行需要執行此操作，這將是非常繁瑣的事情。

任何幫助將不勝感激。

來源

2014-10-06 H0ckeyfr33k99

我以爲你在尋找一個腳本，它實際上爲你複製了行。我想我誤解了。無論如何......我用腳本添加了一個答案。 – JME 2014-10-07 01:58:27

我認爲這可能與式如

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

在ColumnH（H1爲空白）向下複製到適合然後過濾以選擇該列中的0和複製/實現粘貼到一個新的工作表。

來源

2014-10-07 00:04:49 pnuts

嗯...我以爲你在尋找一個腳本。你可能想嘗試這樣的事情：

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

來源

2014-10-07 01:57:40 JME

雖然我最初請求一個腳本來執行這個任務，但我通常會說最簡單的實現是最好的選擇，我覺得像一個簡單的過濾方程是一個簡單的實現。我沒有嘗試過你的解決方案，但是我感謝你提交你的工作，並且猜測它完全按照你的要求工作。 – H0ckeyfr33k99 2014-10-07 02:25:55

檢查下面的代碼。下面的代碼將複製時間等於或大於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

來源

2014-10-09 11:00:31 sam

總和列直到值，然後複製行

回答

相關問題