New paste Repaste Download
Sub CapNhatLichSuDiemDanh_SieuToc()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim arrSource As Variant, arrDest As Variant, arrOut As Variant
    Dim lastRowSource As Long, lastRowDest As Long
    Dim i As Long, j As Long, c As Long
    Dim dictSource As Object, dictDest As Object
    Dim maNV As String
    Dim outRow As Long, maxOutRow As Long
    Dim sVal As Variant
    Dim lastDataCol As Long
    
    ' Tắt cập nhật màn hình để tối ưu tốc độ tối đa
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Set wsSource = ThisWorkbook.Sheets("DIEM DANH")
    Set wsDest = ThisWorkbook.Sheets("LICH SU DIEM DANH KO XOA")
    
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
    lastRowDest = wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Row
    
    If lastRowSource < 11 Then lastRowSource = 11
    If lastRowDest < 11 Then lastRowDest = 11
    
    ' Nạp dữ liệu vào mảng
    arrSource = wsSource.Range("A11:AM" & lastRowSource).Value
    If lastRowDest = 11 And Trim(wsDest.Cells(11, "C").Value) = "" Then
        ReDim arrDest(1 To 1, 1 To 39)
    Else
        arrDest = wsDest.Range("A11:AM" & lastRowDest).Value
    End If
    
    ' Tạo mảng đích để chứa kết quả đầu ra
    ReDim arrOut(1 To UBound(arrSource) + UBound(arrDest) + 100, 1 To 39)
    Set dictSource = CreateObject("Scripting.Dictionary")
    Set dictDest = CreateObject("Scripting.Dictionary")
    
    maxOutRow = 0
    
    ' 1. Lấy dữ liệu hiện tại của Lịch sử vào mảng đích
    If lastRowDest > 11 Or (lastRowDest = 11 And Trim(arrDest(1, 3)) <> "") Then
        For i = 1 To UBound(arrDest, 1)
            maNV = Trim(CStr(arrDest(i, 3)))
            If maNV <> "" Then
                maxOutRow = maxOutRow + 1
                dictDest.Add maNV, maxOutRow
                For c = 1 To 39
                    arrOut(maxOutRow, c) = arrDest(i, c)
                Next c
            End If
        Next i
    End If
    
    ' 2. Đánh chỉ mục nhân viên bên sheet Điểm Danh
    For i = 1 To UBound(arrSource, 1)
        maNV = Trim(CStr(arrSource(i, 3)))
        If maNV <> "" And Not dictSource.exists(maNV) Then
            dictSource.Add maNV, i
        End If
    Next i
    
    ' 3. Xử lý logic chuyển đổi dữ liệu
    For i = 1 To UBound(arrSource, 1)
        maNV = Trim(CStr(arrSource(i, 3)))
        If maNV <> "" Then
            If dictDest.exists(maNV) Then
                outRow = dictDest(maNV)
            Else
                ' Thêm mới nhân viên
                maxOutRow = maxOutRow + 1
                outRow = maxOutRow
                dictDest.Add maNV, outRow
            End If
            
            ' Cột 1 đến 8 (Phần thông tin): Chuyển đủ nguyên vẹn
            For c = 1 To 8
                arrOut(outRow, c) = arrSource(i, c)
            Next c
            
            ' Cột 9 đến 39 (I đến AM): Chỉ chuyển text thành N, không chuyển giờ
            For c = 9 To 39
                sVal = arrSource(i, c)
                If Trim(CStr(sVal)) <> "" Then
                    ' Kiểm tra xem có phải là Text không (Không phải số, không chứa dấu ":" của giờ)
                    If Not IsNumeric(sVal) And Not IsDate(sVal) And InStr(CStr(sVal), ":") = 0 Then
                        arrOut(outRow, c) = "N"
                    End If
                    ' Nếu là giờ phút, đoạn code này sẽ bỏ qua, không ghi đè vào arrOut
                End If
            Next c
        End If
    Next i
    
    ' 4. Xử lý trường hợp bị xóa khỏi Điểm danh (Đánh N từ ngày trống cuối cùng)
    Dim key As Variant
    For Each key In dictDest.keys
        If Not dictSource.exists(key) Then
            outRow = dictDest(key)
            lastDataCol = 8
            For c = 39 To 9 Step -1
                If Trim(CStr(arrOut(outRow, c))) <> "" Then
                    lastDataCol = c
                    Exit For
                End If
            Next c
            
            If lastDataCol >= 8 And lastDataCol < 39 Then
                For c = lastDataCol + 1 To 39
                    arrOut(outRow, c) = "N"
                Next c
            End If
        End If
    Next key
    
    ' 5. Đổ toàn bộ mảng kết quả ra Sheet (Chỉ mất 0.1 giây)
    wsDest.Range("A11:AM" & wsDest.Rows.Count).ClearContents
    If maxOutRow > 0 Then
        wsDest.Range("A11").Resize(maxOutRow, 39).Value = arrOut
    End If
    
    ' Bật lại màn hình
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "Cập nhật dữ liệu siêu tốc hoàn tất!", vbInformation
End Sub
Filename: None. Size: 5kb. View raw, , hex, or download this file.

This paste expires on 2026-10-03 06:54:17.043093+00:00. Pasted through web.