- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 166
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-7-10
               
|
回復 1# cait - Sub nn()
- Dim Ar(11), Rng As Range, cnt%, r&, A As Range, k%, t1&, s&
- Sheet2.Cells = ""
- With Sheet1
- r = 2: k = 1: ay = Array("班次", "連續次數", "編號", "日期", "班次", "車號", "時間", "時間轉換", "速度", "連續時間", "連續距離")
- Do Until r > Application.CountA(.Columns("A"))
- cnt = 1: t1 = .Cells(r, 6): s = .Cells(r, 7): Ar(0) = .Cells(r, 3): Set Rng = .Cells(r, 1).Resize(, 7)
-
- Do Until .Cells(r, 1) + 1 <> .Cells(r + 1, 1) Or .Cells(r, 3) <> .Cells(r + 1, 3)
- r = r + 1
- Set Rng = Union(Rng, .Cells(r, 1).Resize(, 7))
- cnt = cnt + 1
- Loop
- If cnt > 1 Then
- If Rng(1, 3) <> Sheet2.Cells(2, k) And Sheet2.[A1] <> "" Then k = k + 12
- Ar(1) = cnt
- Ar(9) = .Cells(r, 6) - t1
- Ar(10) = Ar(9) * s
- Sheet2.Cells(1, k).Resize(, 11) = ay
- Set A = Sheet2.Cells(65536, k + 2).End(xlUp).Offset(1, 0)
- Sheet2.Cells(A.Row, k).Resize(, 11) = Ar
- Rng.Copy Sheet2.Cells(A.Row + 1, k + 2)
- Erase Ar
- End If
- r = r + 1
- Loop
- End With
- End Sub
複製代碼 |
|