Board logo

標題: 資料整合程式修改 [打印本頁]
作者: s12t34    時間: 2016-11-15 04:01     標題: 資料整合程式修改

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

回復 1# s12t34


    沒有附到附件哦
作者: s12t34    時間: 2016-11-16 05:10

回復 2# starry1314
不好意思 starry1314 大大，我沒注意到
[attach]25816[/attach]
附件補上了，謝謝唷~
:)
作者: Kubi    時間: 2016-11-16 14:02

回復 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    時間: 2016-11-18 04:49

回復 4# Kubi

謝謝Kubi大大的解答~
:)



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)