- 帖子
- 163
- 主題
- 1
- 精華
- 0
- 積分
- 170
- 點名
- 0
- 作業系統
- Window 7
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2010-9-5
- 最後登錄
- 2022-7-20
|
4#
發表於 2016-11-16 14:02
| 只看該作者
回復 3# s12t34
試試看。- Sub test()
- Dim arr, brr(), mytime As Date
- ST = Timer
- mypath = ThisWorkbook.Path & "\"
- myname = "*.*"
- myfile = Dir(mypath & myname)
- Rows("2:65536").Delete
- Application.ScreenUpdating = False
- Do Until myfile = ""
- If myfile <> "總表.xls" Then
- Workbooks.OpenText Filename:=mypath + myfile, Comma:=True, DataType:=xlDelimited
- With ActiveWorkbook.ActiveSheet
- er = .[A65536].End(3).Row
- arr = .Range("A2:I" & er)
- For i = 1 To UBound(arr)
- If arr(i, 1) + arr(i, 2) > mytime Then
- n = n + 1
- ReDim Preserve brr(1 To 9, 1 To n)
- For j = 1 To 9
- brr(j, n) = arr(i, j)
- Next j
- End If
- Next i
- mytime = arr(er - 1, 1) + arr(er - 1, 2)
- .Parent.Close 0
- End With
- End If
- myfile = Dir
- Loop
- [A2].Resize(n, 9) = Application.Transpose(brr)
- Application.ScreenUpdating = True
- arr = ""
- Erase brr
- MsgBox Format(Timer - ST, "0.00秒")
- End Sub
|
|
