資料整合程式修改

如附件：總表.XLS 可以把其資料夾中的檔案匯整一起
請問一下，如何修改把第二個資料檔案延續第一個資資料案最後一筆時間
如下圖，20160611-12的最後一筆為11:42:00；20160611-13第一筆為10:56:27
如何修改去判斷時間大於 20160611-12的最後一筆在貼上，謝謝 :)

樓主熱帖

s12t34

中學生 Rank: 2

帖子: 12
主題: 4
精華: 0
積分: 65
點名: 0
作業系統: Xp
軟體版本: 2003
閱讀權限: 20
性別: 男
註冊時間: 2016-8-5
最後登錄: 2022-6-29

2017 雞年全勤獎章論壇贊助勳章

5^#

發表於 2016-11-18 04:49 | 只看該作者

回復 4# Kubi

謝謝Kubi大大的解答~
:)

TOP

Kubi

中學生 Rank: 2

帖子: 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