資料整合程式修改

s12t34

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

下載 (999.09 KB)

2016-11-15 03:54

下載 (974.72 KB)

2016-11-15 03:54

starry1314

回復 1# s12t34


    沒有附到附件哦

s12t34

回復 2# starry1314
不好意思 starry1314 大大，我沒注意到
r檔匯入.rar (205.24 KB)

下載次數: 9

2016-11-16 05:10

附件補上了，謝謝唷~
:)

Kubi

回復 3# s12t34
試試看。

1. Sub test()
   
2.     Dim arr, brr(), mytime As Date
   
3.     ST = Timer
   
4.     mypath = ThisWorkbook.Path & "\"
   
5.     myname = "*.*"
   
6.     myfile = Dir(mypath & myname)
   
7.     Rows("2:65536").Delete
   
8.     Application.ScreenUpdating = False
   
9.     Do Until myfile = ""
   
10.         If myfile <> "總表.xls" Then
    
11.             Workbooks.OpenText Filename:=mypath + myfile, Comma:=True, DataType:=xlDelimited
    
12.             With ActiveWorkbook.ActiveSheet
    
13.                 er = .[A65536].End(3).Row
    
14.                 arr = .Range("A2:I" & er)
    
15.                 For i = 1 To UBound(arr)
    
16.                     If arr(i, 1) + arr(i, 2) > mytime Then
    
17.                         n = n + 1
    
18.                         ReDim Preserve brr(1 To 9, 1 To n)
    
19.                         For j = 1 To 9
    
20.                             brr(j, n) = arr(i, j)
    
21.                         Next j
    
22.                     End If
    
23.                 Next i
    
24.                 mytime = arr(er - 1, 1) + arr(er - 1, 2)
    
25.                 .Parent.Close 0
    
26.             End With
    
27.         End If
    
28.         myfile = Dir
    
29.     Loop
    
30.     [A2].Resize(n, 9) = Application.Transpose(brr)
    
31.     Application.ScreenUpdating = True
    
32.     arr = ""
    
33.     Erase brr
    
34.     MsgBox Format(Timer - ST, "0.00秒")
    
35. End Sub

複製代碼

s12t34

回復 4# Kubi

謝謝Kubi大大的解答~
:)