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