Lọc theo ngày tháng (1 người xem)

[ZzNHCzZ]

Lọc theo giờ hành chánh

Em có 1 File chấm công của nhân viên.
Em muốn viết Macro để lọc những người đi trể, về sớm, và rổng.

Thứ 2 đến thứ 6 : Sáng 8:00 Chiều 17:00
Thứ 7 làm buổi sáng: Sáng 8:00 Chiều 12:00

Lọc những người ngoài giờ hành chánh. (Vi Phạm)

Mong nhận được giúp đở từ anh chị.

Thân!

 

[ndu96081631]

Thấy dể mà kết hợp điều kiện 1 hồi sao nó rối tùm lum...
For ... Next thì không có vấn đề, nhưng không biết ngoài cách này ra còn cách nào khác không nhỉ? Vì nếu dử liệu nhiều mà For... Next chắc chết!
Advanced Filter khả thi không? Các cao thủ khác gợi ý vài chiêu giúp!

 

[ndu96081631]

Thôi... tạm làm trứơc bằng For.. next vậy (dù cãm thấy dở ẹt)
Tham khảo file nha (không biết dử liệu của bạn nhiều không)

 

[cadafi]

Em có 1 File chấm công của nhân viên.
Em muốn viết Macro để lọc những người đi trể, về sớm, và rổng.

Thứ 2 đến thứ 6 : Sáng 8:00 Chiều 17:00
Thứ 7 làm buổi sáng: Sáng 8:00 Chiều 12:00

Lọc những người ngoài giờ hành chánh. (Vi Phạm)

Mong nhận được giúp đở từ anh chị.

Thân!

Thiết nghĩ không cần dùng Macro làm gì cho đao to búa lớn. Sheet Data bạn thêm một cột phụ nữa dùng IF lọc ra dữ liệu thỏa điều kiện thì cho giá trị là 1, không thỏa điều kiện thì cho giá trị là 0. Sau đó AutoFilter giá trị 1 tại cột phụ này là xong.

Còn muốn dùng Macro cũng được. Dùng tạm một cột phụ bên sheet Data, điền công thức lọc vào cột này, sau đó AutoFliter, copy vùng vừa autoFilter và dán vào sheet khác, sau đó quay lại sheet Data xóa cột phụ đi là xong!

 

[ZzNHCzZ]

Thiết nghĩ không cần dùng Macro làm gì cho đao to búa lớn. Sheet Data bạn thêm một cột phụ nữa dùng IF lọc ra dữ liệu thỏa điều kiện thì cho giá trị là 1, không thỏa điều kiện thì cho giá trị là 0. Sau đó AutoFilter giá trị 1 tại cột phụ này là xong.

Đúng như anh nói, dùng công thức là xong.
Và em cũng đã có kết quả với công thức rồi. Nhưng em muốn làm macro cho pro 1 chút và đồng thời muốn học hỏi cách viết code của các anh chị.

Thôi... tạm làm trứơc bằng For.. next vậy (dù cãm thấy dở ẹt)
Tham khảo file nha (không biết dử liệu của bạn nhiều không)

File của anh chạy rất tốt, em đang test tiếp.
Dữ liệu của em 1 ngày khoảng 300 dòng thôi.

Chân thành cám ơn các anh.
Em vẫn chờ thêm nhiều ý kiến, kết quả của các anh.

Thân!

 

[ndu96081631]

Tôi rút gọn điều kiện lại 1 chút, tuy chưa phải là giãi pháp hay:

Option Explicit
Sub Loc()
  Dim Er As Integer, i As Integer, iR As Integer
  Dim Dk1 As Boolean, Dk2 As Boolean, Dk3 As Boolean
  Dim Time1 As Date, Time2 As Date, Time3 As Date
  Application.ScreenUpdating = False
  Time1 = #8:00:00 AM#: Time2 = #12:00:00 PM#: Time3 = #5:00:00 PM#
  Er = Sheet1.[A65536].End(xlUp).Row: iR = 2
  Sheet2.[A2:E1000].ClearContents
  For i = 2 To Er
    With Sheet1
      Dk1 = (.Cells(i, 4) = "" Or .Cells(i, 5) = "" Or .Cells(i, 4) > Time1)
      Dk2 = (Weekday(.Cells(i, 3), 2) < 6 And .Cells(i, 5) < Time3)
      Dk3 = (Weekday(.Cells(i, 3), 2) = 6 And .Cells(i, 5) < Time2)
      If Dk1 Or Dk2 Or Dk3 Then
         Sheet2.Cells(iR, 1).Resize(1, 5).Value = .Cells(i, 1).Resize(1, 5).Value
         iR = iR + 1
      End If
    End With
  Next i
  Application.ScreenUpdating = True
End Sub

 

[hoangdanh282vn]

Mình gửi 1 cách khác .
do cột thời gian bạn định dạng vừa text vừa time nên mình chuyển về text hết rồi tric lọc

Sub loc()
Dim r As Long
Dim Rng As Range, Cll As Range, RngN As Range, CllN As Range
Dim dk1 As Boolean, dk2 As Boolean, dk3 As Boolean, dk4 As Boolean
With Sheets("DATA")
Set Rng = .Range("C2:C" & .[C65536].End(xlUp).Row)
End With
Application.ScreenUpdating = False
On Error Resume Next
Range("A2:E50000").Clear: r = 2
For Each Cll In Rng
    With Cll
        Set RngN = .Offset(, -2).Resize(1, 5)
        Set CllN = Cells(r, 1)
        dk1 = .Offset(, 1) = "" Or .Offset(, 2) = ""
        dk2 = TimeValue(.Offset(, 1)) > TimeValue("08:00")
        dk3 = TimeValue(.Offset(, 2)) < TimeValue("12:00")
        dk4 = TimeValue(.Offset(, 2)) < TimeValue("17:00")
        Select Case Weekday(.Value)
            Case 7:
                If dk1 Or dk2 Or dk3 Then
                    RngN.Copy Destination:=CllN
                End If
            Case 2 To 6:
                If dk1 Or dk2 Or dk4 Then
                    RngN.Copy Destination:=CllN
                End If
        End Select
    End With
    r = [A65536].End(xlUp).Row + 1
Next
Application.ScreenUpdating = True
Set Rng = Nothing: Set RngN = Nothing: Set CllN = Nothing
End Sub

hay :

Sub loc2()
Dim r As Long
Dim Rng As Range, Cll As Range, RngN As Range, CllN As Range
With Sheets("DATA")
Set Rng = .Range("C2:C" & .[C65536].End(xlUp).Row)
End With
Application.ScreenUpdating = False
Range("A2:E50000").Clear: r = 2
For Each Cll In Rng
    With Cll
        Set RngN = .Offset(, -2).Resize(1, 5)
        Set CllN = Cells(r, 1)
        If .Offset(, 1) = "" Or .Offset(, 2) = "" Then
            RngN.Copy Destination:=CllN
        Else:
        Vla = TimeValue(.Offset(, 1)): Vlb = TimeValue(.Offset(, 2))
        Select Case Weekday(.Value)
            Case 7:
                If Vla > TimeValue("08:00") Or Vlb < TimeValue("12:00") Then
                    RngN.Copy Destination:=CllN
                End If
            Case 2 To 6:
                If Vla > TimeValue("08:00") Or Vlb < TimeValue("17:00") Then
                    RngN.Copy Destination:=CllN
                End If
        End Select
        End If
    End With
    r = [A65536].End(xlUp).Row + 1
Next
Application.ScreenUpdating = True
Set Rng = Nothing: Set RngN = Nothing: Set CllN = Nothing
End Sub