Giúp em tạo macro tách ngày và giây với các bác ơi (1 người xem)

[dmg]

Dear các bác chuyên gia,
Tình hình là em có 1 cái bảng định dạng như trong file đính kèm. Nội dung cơ bản là ghi thời gian bắt đầu (event time), thời gian kết thúc (clear time) của 1 sự kiện ở (site name) sau đó thì ở cột cuối cùng sẽ ghi thời gian xảy ra trong 1 ngày
length = (clear time - event)*86400 (nhân 86400 để tính ra giây, vì 86400 là số giây của 1 ngày)

Vấn đề là như các bác thấy có những sự kiện kéo dài vài ngày, ví dụ như sự kiện B, xảy ra từ mùng 7->9/5 nên phải tách ra thành 3 hàng, mỗi hàng tương ứng 1 ngày.

Nhờ các bác cao thủ viết giúp em cái macro làm việc này với, vì data của em có nhiều sự kiện kéo dài qua ngày như thế này lắm, em xin chân thành cảm ơn, nếu ở hn tiện em mời các bác chầu cape lun :">>

 

[vu_tuan_manh_linh]

Không hiểu ý bạn như thế nào nữa! Tính như công thức trong file là đúng rồi!

 

[dmg]

Vâng, công thức tính giây là chuẩn rồi, nhưng ý mình là tạo 1 macro để tự động tách cái dòng kia ở sự kiện B thành 3 dòng tương ứng với 3 ngày ấy chứ cứ mỗi cái mà cứ ngồi tách tay thành mấy ngày thì mệt lắm

 

[SA_DQ]

Bạn xem trong file kèm theo

. . . , nhưng ý mình là tạo 1 macro để tự động tách cái dòng kia ở sự kiện B thành 3 dòng tương ứng với 3 ngày ấy

 

[dmg]

Wow, many thanks bác.
Nhưng em thử với đầu vào thế này thì nó lại không tách bác ơi
Bác thử xem code còn thiếu gì không với, sắp perfect rùi ^^

Dữ liệu em thử mà không thấy tách, vẫn chỉ để 1 hàng, trong khi cần thành 2 hàng ngày 7 và ngày 8
Bác thử 1 event B với 2 mốc thời gian như sau nhé, nó không tách mà tính thành 86433s
event time: 07/05/2013 11:54:42 PM
clear time: 08/05/2013 12:00:33 AM

 

[vodoi2x]

xem thêm 1 giải pháp - ly cafe

Dear các bác chuyên gia,

Nhờ các bác cao thủ viết giúp em cái macro làm việc này với, vì data của em có nhiều sự kiện kéo dài qua ngày như thế này lắm, em xin chân thành cảm ơn, nếu ở hn tiện em mời các bác chầu cape lun :">>

không phải CHUYÊN GIA; cũng không phải CAO THỦ
nhưng cố kiếm ly cafe vậy

[GPECODE=vb]
Sub Tach()
Dim DataArr, kArr(1 To 10000, 1 To 5)
Dim iR As Long, k As Long, dd As Long

DataArr = Range(Sheet1.[A4], Sheet1.[A65536].End(xlUp)).Resize(, 4)
k = 0
For iR = 1 To UBound(DataArr)
dd = Int(DataArr(iR, 3))
For dd = Int(DataArr(iR, 3)) To Int(DataArr(iR, 4)) - 1
k = k + 1
kArr(k, 1) = DataArr(iR, 1)
kArr(k, 2) = DataArr(iR, 2)
kArr(k, 3) = IIf(dd = Int(DataArr(iR, 3)), DataArr(iR, 3), dd)
kArr(k, 4) = dd + 1
kArr(k, 5) = Round((kArr(k, 4) - kArr(k, 3)) * 86400, 0)
Next dd
k = k + 1
kArr(k, 1) = DataArr(iR, 1)
kArr(k, 2) = DataArr(iR, 2)
kArr(k, 3) = IIf(dd = Int(DataArr(iR, 3)), DataArr(iR, 3), dd)
kArr(k, 4) = DataArr(iR, 4)
kArr(k, 5) = Round((kArr(k, 4) - kArr(k, 3)) * 86400, 0)
Next iR

Sheet1.[g4].Resize(k, 5) = kArr
End Sub
[/GPECODE]

bấm nút tach trong file gửi kèm

 

[dmg]

Cà phê thôi các bác ơi

 

[vodoi2x]

không phải CHUYÊN GIA; cũng không phải CAO THỦ
nhưng cố kiếm ly cafe vậy


bấm nút tach trong file gửi kèm

Đổi lại thế này cho đẹp hơn
[GPECODE=vb]Sub Tach()
Dim DataArr, kArr(1 To 10000, 1 To 5)
Dim iR As Long, k As Long, dd As Long

DataArr = Range(Sheet1.[A4], Sheet1.[A65536].End(xlUp)).Resize(, 4)
k = 0
For iR = 1 To UBound(DataArr)
dd = Int(DataArr(iR, 3))
For dd = Int(DataArr(iR, 3)) To Int(DataArr(iR, 4)) - 1
k = k + 1
kArr(k, 1) = DataArr(iR, 1)
kArr(k, 2) = DataArr(iR, 2)
kArr(k, 3) = IIf(dd = Int(DataArr(iR, 3)), DataArr(iR, 3), dd)
kArr(k, 4) = dd + 1
kArr(k, 5) = Round((kArr(k, 4) - kArr(k, 3)) * 86400, 0)
Next dd
k = k + 1
kArr(k, 1) = DataArr(iR, 1)
kArr(k, 2) = DataArr(iR, 2)
kArr(k, 3) = dd
kArr(k, 4) = DataArr(iR, 4)
kArr(k, 5) = Round((kArr(k, 4) - kArr(k, 3)) * 86400, 0)
Next iR

If k Then Sheet1.[g4].Resize(k, 5) = kArr
End Sub
[/GPECODE]

 

[dmg]

Ơ, nhưng sao nó lại tính sai second của thằng A nhỉ thui thì xài cái trước cũng được bác ạ, để em về ngâm cứu code của bác sau thanks bác

 

[vodoi2x]

Ơ, nhưng sao nó lại tính sai second của thằng A nhỉ thui thì xài cái trước cũng được bác ạ, để em về ngâm cứu code của bác sau thanks bác

Đúng là nhầm rùi, bạn lấy code trước đi,

tôi cũng đi làm ly cafe banme đây

 

[dmg]

Bác nào ở cầu giấy thì cuối tuần em mời cape tô hiệu nhé

 

[hieuxd]

Bác nào ở cầu giấy thì cuối tuần em mời cape tô hiệu nhé

Bạn ở cầu giấy nếu có thời gian mời bạn đến đây uống cà Phê
Cuối tuần có rất nhiều thành viên về đây uống cà phê
http://www.giaiphapexcel.com/forum/...SN-GPE-lần-thứ-7-ngày-07-7-2013-tại-TP-HÀ-NỘI

 

[sealand]

Còn cà phê cho mình 1 ly, thêm cho bạn 1 code để toét mắt. Mà toét mắt thì tớ đến sau tớ đỡ phần còn lại nha
Mình mượn file của bác vodoi2x làm cho bạn. Nói chung cũng tham khảo và thay đổi cách tính cũng như giải pháp để phong phú cách giải thôi. Mình có 2 Code thích thì chia mà bực mình thì xoá:

Sub SplitTime()
Dim Db, Rs(1 To 10000, 1 To 5), Tmp, i, j
Db = Range(Sheet1.[A4], Sheet1.[A65536].End(xlUp)).Resize(, 4)
For i = 1 To UBound(Db, 1)
Do While Db(i, 3) < Db(i, 4)
Tmp = CDate(DateSerial(Year(Db(i, 3)), Month(Db(i, 3)), Day(Db(i, 3))) + 1 & " 12:00:00AM")
j = j + 1
Rs(j, 1) = Db(i, 1): Rs(j, 2) = Db(i, 2): Rs(j, 3) = Db(i, 3)
Rs(j, 4) = IIf(Tmp < Db(i, 4), Tmp, Db(i, 4))
Rs(j, 5) = IIf(Tmp < Db(i, 4), DateDiff("s", Db(i, 3), Tmp), DateDiff("s", Db(i, 3), Db(i, 4)))
Db(i, 3) = Tmp
Loop
Next
 Sheet1.[g4].Resize(j, 5) = Rs
End Sub
'-----------------------Phần Code xoá kết quả
Sub DelRs()
Sheet1.Range(Sheet1.[G65536].End(3), Sheet1.[K4]).ClearContents
End Sub