Giúp tôi sắp sếp thời gian theo thứ tự từng ngày (2 người xem)

[hoang0569]

Tôi có gửi File bên hàm và công thức, các anh chị cũng đã giúp tôi làm nhưng Khi làm nảy sinh vấn đề khác nên tôi gửi File sang bên chuyên mục VBA mong các anh các bạn giúp tôi hoàn thiện File hơn,xin cảm ơn nhiều.

 

[HungQuoc49]

Tôi có gửi File bên hàm và công thức, các anh chị cũng đã giúp tôi làm nhưng Khi làm nảy sinh vấn đề khác nên tôi gửi File sang bên chuyên mục VBA mong các anh các bạn giúp tôi hoàn thiện File hơn,xin cảm ơn nhiều.

Tức là sắp xếp theo màu sắc và giờ?

 

[hoang0569]

Không anh ạ, chỉ sắp sếp theo giờ, bắt đầu là giờ sớm nhất của ngày sớm nhất, ở File trên là bắt đầu từ 22h ngày 1 trở đi anh a;

 

[HungQuoc49]

Chạy thử cái này xem sao
Kết quả dán vào sheet2

Public Sub Thoi_Gian_SX()
Dim dl, tt, ngay(24, 1 To 100), kq(), r As Long, c As Long, i

tt = Sheet1.Range("C2:E2")
dl = Sheet1.Range("C4:E13")

ReDim kq(1 To 1000, 1 To 1)

For c = 1 To UBound(dl, 2)
i = tt(1, c)
If dl(1, c) = 0 Then i = i + 1     '<---Thay đổi cách tính chỉ số i cho dòng đầu tiên'
ngay(dl(1, c), i) = dl(1, c)

For r = 2 To UBound(dl)
If dl(r, c) < dl(r - 1, c) Then i = i + 1
ngay(dl(r, c), i) = dl(r, c)
Next r
Next c

i = 0
For c = 1 To UBound(ngay, 2)
For r = 0 To UBound(ngay)
If ngay(r, c) <> "" Then
i = i + 1
kq(i, 1) = ngay(r, c)
End If
Next r
Next c

Sheet2.UsedRange.Clear
Sheet2.Range("A1").Resize(i, 1) = kq
End Sub

 

[hoang0569]

Anh ơi em quên mất, em đang dùng Excel 2003 và có thể chạy nhiều bảng như vậy 1 lúc không anh?

 

[hoang0569]

Có thể chạy nhiều bảng 1 lúc và kết quả ra song song với mỗi bảng theo chiều dọc được không anh, giúp em nhé.

 

[HungQuoc49]

Anh ơi em quên mất, em đang dùng Excel 2003 và có thể chạy nhiều bảng như vậy 1 lúc không anh?

Có lẽ là được.
-------------

 

[hoang0569]

Anh HungQuoc49 giúp em với nhé, cảm ơn anh nhiều.

 

[HungQuoc49]

Bạn gửi file ví dụ có 1-2 bảng kèm theo kết quả giả định lên xem sao

 

[hoang0569]

Em gửi File anh xem giúp.

 

[HungQuoc49]

Em gửi File anh xem giúp.

Bố trí lại dữ liệu cho dễ làm
kết quả dán vào sheet2 theo từng cột

Public kq(), i

Public Sub TG_SX(dl(), tt())
Dim ngay(24, 1 To 100), r As Long, c As Long

ReDim kq(1 To UBound(dl) * UBound(dl, 2), 1 To 1)

For c = 1 To UBound(dl, 2)
i = tt(1, c)
If dl(1, c) = 0 Then i = i + 1     '<---Thay đổi cách tính chỉ số i cho dòng đầu tiên'
ngay(dl(1, c), i) = dl(1, c)

For r = 2 To UBound(dl)
If dl(r, c) < dl(r - 1, c) Then i = i + 1
ngay(dl(r, c), i) = dl(r, c)
Next r
Next c

i = 0
For c = 1 To UBound(ngay, 2)
For r = 0 To UBound(ngay)
If ngay(r, c) <> "" Then
i = i + 1
kq(i, 1) = ngay(r, c)
End If
Next r
Next c

End Sub


Public Sub Tong()
Dim dl(), tt(), r As Long, rw As Long, j

Sheet2.UsedRange.Clear

With Sheet1
rw = .UsedRange.Rows.Count

For r = 1 To rw Step 13
j = j + 1
Sheet2.Cells(1, j) = j

tt = .Range("D" & r).CurrentRegion
dl = .Range("D" & r + 2).CurrentRegion
Call TG_SX(dl, tt)
Sheet2.Range("A3").Offset(, j - 1).Resize(i, 1) = kq
Next r
End With

Sheet2.UsedRange.Columns.AutoFit
End Sub

 

[hoang0569]

Anh à, trường hợp thứ 3 phài là 23, 0 ,1 mới đúng vì 0h đã bước sang ngày hôm sau rồi, anh sửa lại giúp em với. cảm ơn anh

 

[HungQuoc49]

Anh à, trường hợp thứ 3 phài là 23, 0 ,1 mới đúng vì 0h đã bước sang ngày hôm sau rồi, anh sửa lại giúp em với. cảm ơn anh

Thêm dấu nháy đơn ' trước câu lệnh này

If dl(1, c) = 0 Then i = i + 1     '<---Thay đổi cách tính chỉ số i cho dòng đầu tiên'

 

[hoang0569]

Cảm ơn anh rất nhiều, chúc anh luôn vui, khỏe.