因每筆時間皆為8秒,所以不已時間做判斷,直接已連續4筆資料做判斷>20秒
Sub ex()
Dim R As Long, Cmax As Integer
Sheets("Sheet2").Range("A1").CurrentRegion.Delete
Sheets("Sheet1").Range("a2:t3").Copy Sheets("Sheet2").Range("a1")
With Sheets("Sheet1").Range("A1").CurrentRegion
R = 4
Do While R <= .Rows.Count
Cmax = 0
Do While .Cells(R + Cmax, 17) > 5 And .Cells(R + Cmax, 17) <> ""
Cmax = Cmax + 1
Loop
If Cmax >= 4 Then Sheets("sheet1").Range(Cells(R, 1), Cells((R + Cmax - 1), 20)).Copy Sheets("Sheet2").Range("b65536").End(xlUp).Offset(1, -1)
R = R + 1 + Cmax
Loop
End With
End Sub