- 帖子
- 234
- 主題
- 19
- 精華
- 0
- 積分
- 276
- 點名
- 0
- 作業系統
- Windows XP
- 軟體版本
- office 2003
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2013-1-7
- 最後登錄
- 2021-10-7
|
3#
發表於 2015-5-28 09:39
| 只看該作者
回復 2# gagashe
因每筆時間皆為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 |
|
