Lọc bảng chấm công theo từ tổng hợp ra chi tiết

MinhKhai · 29/5/23

Em có bảng chấm công thủ công tại sheet CC, muốn từ đây có thể lọc theo mẫu tại sheet Chi tiết.
Nếu có thể nhờ các bác giúp đoạn hàm để lọc, nếu không thể dùng hàm, hoặc dùng hàm dài dòng thì nhờ các bác giúp cho đoạn code VBA.
XIn chân thành cảm ơn các bác !

BuiQuangThuan · 29/5/23

Không có mã số nhân viên là điều có khả năng dẫn sai nhất đó. Rồi có tới 5-7 thằng tên giống nhau thì bạn tính thế nào?

longtay1111 · 29/5/23

MinhKhai đã viết:
Em có bảng chấm công thủ công tại sheet CC, muốn từ đây có thể lọc theo mẫu tại sheet Chi tiết.
Nếu có thể nhờ các bác giúp đoạn hàm để lọc, nếu không thể dùng hàm, hoặc dùng hàm dài dòng thì nhờ các bác giúp cho đoạn code VBA.
XIn chân thành cảm ơn các bác !

Bạn thử

K4=IFERROR(INDEX(CC!$C$3:$AM$3,,AGGREGATE(15,6,TRANSPOSE(ROW($1:$100))/(CC!$B$4:$B$15=Chitiet!$D$5)/(CC!$C$3:$AM$3>Chitiet!$D$6)/(CC!$C$3:$AM$3<Chitiet!$D$7)/(CC!$C$4:$AM$16<>""),ROW(A1))),"")

L4=IFERROR(INDEX(CC!$C$4:$AM$4,,AGGREGATE(15,6,TRANSPOSE(ROW($1:$100))/(CC!$C$3:$AM$3=Chitiet!$H4),ROW($A$1))),"")

Bạn xem file có đúng ko

BuiQuangThuan · 29/5/23

MinhKhai đã viết:
giúp cho đoạn code VBA.

Test thử. Hên xui. Viết xong không kiểm tra kỹ.

Mã:

Option Explicit
Sub ABC()
    Dim Dic As Object, i&, sArr(), j&, TenNV$, sNgay, eNgay, S, Res(), K&
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("CC")
        sArr = .Range("B3").Resize(.Range("B" & Rows.Count).End(3).Row - 2, .Cells(3, Columns.Count).End(1).Column - 1).Value
        For i = 2 To UBound(sArr)
            For j = 2 To UBound(sArr, 2)
                If sArr(i, j) <> Empty Then
                    Dic(sArr(i, 1)) = Dic(sArr(i, 1)) & "|" & sArr(1, j)
                End If
            Next
        Next
    End With
    With Sheets("Chitiet")
        TenNV = .Range("D5").Value
        sNgay = .Range("D6").Value
        eNgay = .Range("D7").Value
        If Dic.exists(TenNV) = True Then
            S = Split(Dic.Item(TenNV), "|")
            ReDim Res(1 To UBound(S), 1 To 2)
            For i = 1 To UBound(S)
                If CDate(S(i)) >= sNgay And CDate(S(i)) <= eNgay Then
                    K = K + 1
                    Res(K, 1) = S(i)
                    Res(K, 2) = "x"
                End If
            Next
        End If
        .Range("H4:I2000").ClearContents
        .Range("H4").Resize(K, 2).Value = Res
    End With
End Sub

cantl · 29/5/23

longtay1111 đã viết:
Bạn thử

K4=IFERROR(INDEX(CC!$C$3:$AM$3,,AGGREGATE(15,6,TRANSPOSE(ROW($1:$100))/(CC!$B$4:$B$15=Chitiet!$D$5)/(CC!$C$3:$AM$3>Chitiet!$D$6)/(CC!$C$3:$AM$3<Chitiet!$D$7)/(CC!$C$4:$AM$16<>""),ROW(A1))),"")

L4=IFERROR(INDEX(CC!$C$4:$AM$4,,AGGREGATE(15,6,TRANSPOSE(ROW($1:$100))/(CC!$C$3:$AM$3=Chitiet!$H4),ROW($A$1))),"")

Bạn xem file có đúng ko

L4 gì mà dài dữ vậy?

MinhKhai · 29/5/23

BuiQuangThuan đã viết:
Không có mã số nhân viên là điều có khả năng dẫn sai nhất đó. Rồi có tới 5-7 thằng tên giống nhau thì bạn tính thế nào?

Cảm ơn bác đã nhắc. Đây là bản nháp nên em loại bỏ các thông tin khác cho khỏi rối thôi ai. Em thực tế sẽ có mã số NV.

Bài đã được tự động gộp: 29/5/23

longtay1111 đã viết:
Bạn thử

K4=IFERROR(INDEX(CC!$C$3:$AM$3,,AGGREGATE(15,6,TRANSPOSE(ROW($1:$100))/(CC!$B$4:$B$15=Chitiet!$D$5)/(CC!$C$3:$AM$3>Chitiet!$D$6)/(CC!$C$3:$AM$3<Chitiet!$D$7)/(CC!$C$4:$AM$16<>""),ROW(A1))),"")

L4=IFERROR(INDEX(CC!$C$4:$AM$4,,AGGREGATE(15,6,TRANSPOSE(ROW($1:$100))/(CC!$C$3:$AM$3=Chitiet!$H4),ROW($A$1))),"")

Bạn xem file có đúng ko

Cảm ơn hàm của bác. Hàm lại K4 đã chạy chạy khá tốt ạ.
Tuy nhiên có vấn đề sau:
- Hàm tại K4 em thử đổi (CC!$C$3:$AM$3>Chitiet!$D$6) thành (CC!$C$3:$AM$3 > = Chitiet!$D$6) và (CC!$C$3:$AM$3<Chitiet!$D$7) thành (CC!$C$3:$AM$3 < = Chitiet!$D$7) để lấy cả giá trị đầu và cuối thì kết quả không ra như muong muốn. Nhờ bác chỉ giúp
- Hàm tại L không ra hết dữ liệu tương ứng với cột K, em dùng thử HLOOKUP thấy nó tạm thời OK ạ
Một lần nữa cảm ơn bác rất nhiều

Bài đã được tự động gộp: 29/5/23

cantl đã viết:
L4 gì mà dài dữ vậy?

Em mượn kết quả của bác @longtay1111 tại cột K rồi dùng HLOOKUP cho cột L ạ.
L4=IF(K4="","",HLOOKUP(K4,CC!$C$3:$AM$15,MATCH(Chitiet!$D$5,CC!$B$3:$B$51,0),0))

MinhKhai · 29/5/23

BuiQuangThuan đã viết:

Test thử. Hên xui. Viết xong không kiểm tra kỹ.

Mã:

Option Explicit
Sub ABC()
    Dim Dic As Object, i&, sArr(), j&, TenNV$, sNgay, eNgay, S, Res(), K&
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("CC")
        sArr = .Range("B3").Resize(.Range("B" & Rows.Count).End(3).Row - 2, .Cells(3, Columns.Count).End(1).Column - 1).Value
        For i = 2 To UBound(sArr)
            For j = 2 To UBound(sArr, 2)
                If sArr(i, j) <> Empty Then
                    Dic(sArr(i, 1)) = Dic(sArr(i, 1)) & "|" & sArr(1, j)
                End If
            Next
        Next
    End With
    With Sheets("Chitiet")
        TenNV = .Range("D5").Value
        sNgay = .Range("D6").Value
        eNgay = .Range("D7").Value
        If Dic.exists(TenNV) = True Then
            S = Split(Dic.Item(TenNV), "|")
            ReDim Res(1 To UBound(S), 1 To 2)
            For i = 1 To UBound(S)
                If CDate(S(i)) >= sNgay And CDate(S(i)) <= eNgay Then
                    K = K + 1
                    Res(K, 1) = S(i)
                    Res(K, 2) = "x"
                End If
            Next
        End If
        .Range("H4:I2000").ClearContents
        .Range("H4").Resize(K, 2).Value = Res
    End With
End Sub

Code của bác chạy tốt
Tuy nhiên không hiểu sao khi code chạy, định dạng ngày tháng tại cột H vẫn cứ không đồng nhất dù em đã vào Format Cells để chỉnh về 1 kiểu. Bác xem lại giúp em với nhé

cantl · 29/5/23

MinhKhai đã viết:
L4

L4 = IF(K4,"x") thôi mà.

MinhKhai · 29/5/23

cantl đã viết:
L4 = IF(K4,"x") thôi mà.

Bác nói em mới để ý. Em dùng HLOOKUP để lấy được ký hiệu thực tế bên sheet CC
Quay lại Code bác viết, hình như cột I mặc định là x hết. Giả sử bên dữ liệu gốc thay đổi ký hiệu hoặc mỗi người, mỗi ngày có 1 ký hiệu riêng thì dữ liệu tại cột I từ code của bác không đạt yêu cầu. Nhờ bác xử lý thêm giúp em cái này nhé.
Trân trọng !

cantl · 29/5/23

MinhKhai đã viết:
Bác nói em mới để ý. Em dùng HLOOKUP để lấy được ký hiệu thực tế bên sheet CC
Quay lại Code bác viết, hình như cột I mặc định là x hết. Giả sử bên dữ liệu gốc thay đổi ký hiệu hoặc mỗi người, mỗi ngày có 1 ký hiệu riêng thì dữ liệu tại cột I từ code của bác không đạt yêu cầu. Nhờ bác xử lý thêm giúp em cái này nhé.
Trân trọng !

View attachment 290782

Hehe, thế thì phải dùng hàm bạn trên hoặc hlookup, hoặc ... Đấy là bạn rút kinh nghiệm để sau đưa nhiều tình huống thôi. Bảng để mỗi x thế kia thì sẽ kích thích độ lười mà.

Bài đã được tự động gộp: 29/5/23

MinhKhai đã viết:
Code

Mà đây là hàm, tớ không biết code, viết thế GPE cười tớ đấy. :wallbash:

Thóc Sama · 30/5/23

MinhKhai đã viết:
Em có bảng chấm công thủ công tại sheet CC, muốn từ đây có thể lọc theo mẫu tại sheet Chi tiết.
Nếu có thể nhờ các bác giúp đoạn hàm để lọc, nếu không thể dùng hàm, hoặc dùng hàm dài dòng thì nhờ các bác giúp cho đoạn code VBA.
XIn chân thành cảm ơn các bác !

Bạn thử code dưới.
(Thay đổi giá trị ở sheet [Chitiet] ô D5-->D7 rồi kiểm tra kết quả)

Mã:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D5:D7")) Is Nothing Then
    Sheet2.Range("H4:I10000").ClearContents
    On Error Resume Next
    Dim Lr&, i&, Res(), Arr(), k&, Lc&
        Dim sName$, fDate&, tDate&, j&
        With Sheet2
            sName = .Range("D5").Value
            fDate = CLng(.Range("D6").Value)
            tDate = CLng(.Range("D7").Value)
        End With
        With Sheet1
            Lr = .Range("B" & Rows.Count).End(xlUp).Row
            Lc = .Cells(3, .Columns.Count).End(xlToLeft).Column
            Arr = .Range(.Cells(3, 2), .Cells(Lr, Lc)).Value
            ReDim Res(1 To UBound(Arr, 2), 1 To 2)
            For i = 2 To UBound(Arr)
                For j = 2 To UBound(Arr, 2)
                    If Arr(i, 1) = sName Then
                        If Arr(1, j) >= fDate And Arr(1, j) <= tDate Then
                            If Arr(i, j) = "x" Then
                                k = k + 1
                                Res(k, 1) = Arr(1, j)
                                Res(k, 2) = Arr(i, j)
                            End If
                        End If
                    End If
                Next j
            Next i
        End With
        With Sheet2
            If k Then
                .Range("H4:I" & UBound(Arr, 2)).ClearContents
                .Range("H4").Resize(k, 2).Value = Res
                MsgBox "Jisshi sumi"
            End If
        End With
    End If
End Sub

Nhattanktnn · 30/5/23

MinhKhai đã viết:
Em có bảng chấm công thủ công tại sheet CC, muốn từ đây có thể lọc theo mẫu tại sheet Chi tiết.
Nếu có thể nhờ các bác giúp đoạn hàm để lọc, nếu không thể dùng hàm, hoặc dùng hàm dài dòng thì nhờ các bác giúp cho đoạn code VBA.
XIn chân thành cảm ơn các bác !

Công thức tại H4:

Mã:

=IFERROR(INDEX(CC!$C$3:$AM$3,AGGREGATE(15,6,COLUMN(CC!$A$3:$AM$3)/(INDEX(CC!$C$4:$AM$15,MATCH($D$5,CC!$B$4:$B$15,0),)="x")/(CC!$C$3:$AM$3>=$D$6)/(CC!$C$3:$AM$3<=$D$7),ROW(A1))),"")

Công thức tại I4:

Mã:

=IF(H4<>"","x","")

hocexcel_1991 · 30/5/23

Thêm cách dùng Power Query

Mã:

let
    Source0 = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source0, {"NHÂN VIÊN"}, "DATE", "T"),
    #"Changed Type" = Table.TransformColumnTypes(#"Unpivoted Other Columns",{{"DATE", type datetime}}),
    Source1 =Excel.CurrentWorkbook(){[Name="Table2"]}[Content],
    Custom1 = Table.SelectRows(#"Changed Type", each [NHÂN VIÊN]=Source1[Column2]{0} and [DATE]>=Source1[Column2]{1} and [DATE]<=Source1[Column2]{2} ),
    #"Changed Type1" = Table.TransformColumnTypes(Custom1,{{"DATE", type date}}),
    #"Removed Other Columns" = Table.SelectColumns(#"Changed Type1",{"DATE", "T"})
in
    #"Removed Other Columns"

fastfood10 · 30/5/23

MinhKhai đã viết:
Em có bảng chấm công thủ công tại sheet CC, muốn từ đây có thể lọc theo mẫu tại sheet Chi tiết.
Nếu có thể nhờ các bác giúp đoạn hàm để lọc, nếu không thể dùng hàm, hoặc dùng hàm dài dòng thì nhờ các bác giúp cho đoạn code VBA.
XIn chân thành cảm ơn các bác !

Bạn xem file xem đúng như mong muốn không ?

MinhKhai · 2/6/23

THÓC SAMA đã viết:

Bạn thử code dưới.
(Thay đổi giá trị ở sheet [Chitiet] ô D5-->D7 rồi kiểm tra kết quả)

Mã:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D5:D7")) Is Nothing Then
    Sheet2.Range("H4:I10000").ClearContents
    On Error Resume Next
    Dim Lr&, i&, Res(), Arr(), k&, Lc&
        Dim sName$, fDate&, tDate&, j&
        With Sheet2
            sName = .Range("D5").Value
            fDate = CLng(.Range("D6").Value)
            tDate = CLng(.Range("D7").Value)
        End With
        With Sheet1
            Lr = .Range("B" & Rows.Count).End(xlUp).Row
            Lc = .Cells(3, .Columns.Count).End(xlToLeft).Column
            Arr = .Range(.Cells(3, 2), .Cells(Lr, Lc)).Value
            ReDim Res(1 To UBound(Arr, 2), 1 To 2)
            For i = 2 To UBound(Arr)
                For j = 2 To UBound(Arr, 2)
                    If Arr(i, 1) = sName Then
                        If Arr(1, j) >= fDate And Arr(1, j) <= tDate Then
                            If Arr(i, j) = "x" Then
                                k = k + 1
                                Res(k, 1) = Arr(1, j)
                                Res(k, 2) = Arr(i, j)
                            End If
                        End If
                    End If
                Next j
            Next i
        End With
        With Sheet2
            If k Then
                .Range("H4:I" & UBound(Arr, 2)).ClearContents
                .Range("H4").Resize(k, 2).Value = Res
                MsgBox "Jisshi sumi"
            End If
        End With
    End If
End Sub

Cảm ơn bác đã giúp. Code chạy tốt.
Tuy nhiên có 1 vấn đề nhỏ là ký hiệu ở sheet CC không phải là X thì kết quả ở cột I4 nó không thay đổi theo. Mô tả vấn đề này em đã nêu ở #9. Tuy nhiên bác @fastfood10 ở #14 đã xử lý như ý em muốn.

Bài đã được tự động gộp: 2/6/23

Nhattanktnn đã viết:
Công thức tại H4:

Mã:

=IFERROR(INDEX(CC!$C$3:$AM$3,AGGREGATE(15,6,COLUMN(CC!$A$3:$AM$3)/(INDEX(CC!$C$4:$AM$15,MATCH($D$5,CC!$B$4:$B$15,0),)="x")/(CC!$C$3:$AM$3>=$D$6)/(CC!$C$3:$AM$3<=$D$7),ROW(A1))),"")

Công thức tại I4:

Mã:

=IF(H4<>"","x","")

Hàm của bác đặt tại H4 đã chạy tốt ạ. Cảm ơn bác.
Tuy nhiên hàm tại I4 chưa đúng ý em, do nó cần lấy ký hiệu ở sheet CC chứ không phải mặc định là dấu x

Bài đã được tự động gộp: 2/6/23

fastfood10 đã viết:
Bạn xem file xem đúng như mong muốn không ?

Code của bác đã hoạt động đúng như mong muốn. Cảm ơn bác nhé.

MinhKhai · 2/6/23

hocexcel_1991 đã viết:

Thêm cách dùng Power Query

Mã:

let
    Source0 = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source0, {"NHÂN VIÊN"}, "DATE", "T"),
    #"Changed Type" = Table.TransformColumnTypes(#"Unpivoted Other Columns",{{"DATE", type datetime}}),
    Source1 =Excel.CurrentWorkbook(){[Name="Table2"]}[Content],
    Custom1 = Table.SelectRows(#"Changed Type", each [NHÂN VIÊN]=Source1[Column2]{0} and [DATE]>=Source1[Column2]{1} and [DATE]<=Source1[Column2]{2} ),
    #"Changed Type1" = Table.TransformColumnTypes(Custom1,{{"DATE", type date}}),
    #"Removed Other Columns" = Table.SelectColumns(#"Changed Type1",{"DATE", "T"})
in
    #"Removed Other Columns"

Em mở file đính kèm mà chưa rõ cách dùng, bác mô tả để em học hỏi thêm nhé !

fastfood10 · 3/6/23

@MinhKhai Hình như hàm transpose mình lập lại là hơi thừa thải, như phía dưới vậy mới đúng bạn nhé

Mã:

=LET(X,TRANSPOSE(IF(KQCC=0,"",KQCC)),FILTER(X,X<>""))

Mã:

=LET(X,TRANSPOSE(IF(KQCC=0,"",KQN)),FILTER(X,X<>""))

Lọc bảng chấm công theo từ tổng hợp ra chi tiết

Giải pháp Ếc-xào

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên hoạt động

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

!!! Giải thoát !!!

Giải pháp Ếc-xào

Giải pháp Ếc-xào

!!! Giải thoát !!!

Giải pháp Ếc-xào

!!! Giải thoát !!!

＿/＿/＿/＿/＿/＿/＿/

File đính kèm

Thành viên gắn bó

Bắt đầu học Excel

File đính kèm

Học hỏi là chính

File đính kèm

Giải pháp Ếc-xào

Giải pháp Ếc-xào

Học hỏi là chính