Viết code cho file lấy dữ liệu in -out từ bảng chấm công (1 người xem)

[kimthoa89]

Em chào các anh chị !
mong anh chị giúp đỡ file lấy dữ liệu in - out
1. Lấy dữ liệu từ Sheet xuất sang xin in - out
2. ở sheet xuất có bao nhiêu mã nhân viên thì chạy ra shet in out bấy nhiêu mã nhân viên họ và tên giờ ra vào
3. in out cột K , giờ ra vào cột e của sheet xuẩt
mong anh chị giúp dỡ , em cảm ơn ạ

 

[yaaasoo01]

Thấy chưa ai support nên mình nhờ AI viết cho bạn 1 đoạn

Sub UpdateInOutSheet()
    Dim wsData As Worksheet, wsInOut As Worksheet
    Dim lastRow As Long, i As Long
    Dim dict As Object
    Dim key As Variant
    Dim Number As String, Name As String, CheckDate As String, CheckTime As String, StatusDesc As String
    Dim tempArr As Variant
    
    Set wsData = Sheet4
    Set wsInOut = ThisWorkbook.Sheets("IN -OUT")
    Set dict = CreateObject("Scripting.Dictionary")

    lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastRow
        Number = Trim(wsData.Cells(i, 1).Value)
        Name = Trim(wsData.Cells(i, 2).Value)
        CheckDate = Format(wsData.Cells(i, 4).Value, "mm/dd/yyyy")
        CheckTime = Format(wsData.Cells(i, 5).Value, "hh:mm")
        StatusDesc = UCase(Trim(wsData.Cells(i, 11).Value))

        key = Number & "|" & Name & "|" & CheckDate

        
        If dict.exists(key) Then
            tempArr = dict(key)
        Else
            tempArr = Array("", "")
        End If


        If StatusDesc = "IN" Then
            tempArr(0) = CheckTime
        ElseIf StatusDesc = "OUT" Then
            tempArr(1) = CheckTime
        End If
        
        dict(key) = tempArr

    Next i


    'wsInOut.Cells.ClearContents
    'wsInOut.Range("A1:E1").Value = Array("Number", "Name", "Check Date", "Time In", "Time Out")

    i = 8
    For Each key In dict.Keys
        Dim parts() As String
        parts = Split(key, "|")
        wsInOut.Cells(i, 2).Value = parts(2)
        wsInOut.Cells(i, 3).Value = parts(0)
        wsInOut.Cells(i, 4).Value = parts(1)
        wsInOut.Cells(i, 5).Value = dict(key)(0)
        wsInOut.Cells(i, 6).Value = dict(key)(1)
        i = i + 1
    Next key

    MsgBox "Done!"
End Sub