Nhờ anh chị xem giúp em file cell có VBA này. (2 người xem)

'Kiem tra tiet trung cua GV

Sub KiemTraTrung()
Dim rng As Range
Dim cell As Range
Dim dict As Object
Dim a As Integer
Dim textAfterDash As String
Dim key As String
Dim duplicateCount As Integer

' Tang t?c macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

' Xóa d?nh d?ng màu n?n cu
ActiveSheet.Cells.Interior.ColorIndex = xlNone

' Kh?i t?o b? d?m s? lu?ng trùng
duplicateCount = 0

' Duy?t qua t?ng hàng t? 4 d?n 58
For a = 4 To 58
Set rng = ActiveSheet.Range(Cells(a, 2), Cells(a, 19))

' Ki?m tra ph?m vi có t?n t?i
If rng Is Nothing Then Exit Sub

' T?o Dictionary d? luu tr? giá tr?
Set dict = CreateObject("Scripting.Dictionary")

' Duy?t qua t?ng ô và thêm vào Dictionary
For Each cell In rng
If InStr(cell.value, "-") > 0 Then
textAfterDash = Trim(Mid(cell.value, InStr(cell.value, "-") + 1))
key = textAfterDash

' Ki?m tra trùng l?p trong Dictionary
If key <> "" Then
If dict.Exists(key) Then
If dict(key).Interior.Color <> RGB(255, 0, 0) Then
dict(key).Interior.Color = RGB(255, 0, 0) ' Bôi d? ô trùng l?p d?u tiên
duplicateCount = duplicateCount + 1 ' Tang s? lu?ng trùng
End If
cell.Interior.Color = RGB(255, 0, 0) ' Bôi d? ô hi?n t?i
Else
dict.Add key, cell
End If
End If
End If
Next cell
Next a

' Khôi ph?c cài d?t Excel
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

MsgBox "Tông so luong ô trùng là: " & duplicateCount, vbInformation
End Sub
'----------- Tìm theo Giáo viên ----------------

Sub TimTheoGiaoVien()
Dim ws As Worksheet
Set ws = ActiveSheet
Application.ScreenUpdating = False ' T?t c?p nh?t màn hình d? tang t?c

' Tìm dòng cu?i cùng trong c?t B
Dim lastRow As Integer
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).row

' Luu d? li?u vào m?ng d? tang t?c
Dim tkbChung As Variant, tenLop As Variant
tkbChung = ws.Range("C4:S" & lastRow).value
tenLop = ws.Range("C3:S3").value

Dim rowCount As Integer, colCount As Integer
rowCount = UBound(tkbChung, 1)
colCount = UBound(tkbChung, 2)

' Khai báo m?ng k?t qu?
Dim resultArr() As String
ReDim resultArr(1 To 61, 1 To 1)

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

Dim i As Integer, j As Integer, k As Integer
Dim splitData As Variant, teacherName As String, subjectInfo As String, className As String

k = 0 ' Ch? s? c?t trong m?ng k?t qu?

' Duy?t qua t?ng c?t d? tách thông tin giáo viên
For j = 1 To colCount
className = Split(tenLop(1, j), "(")(0) ' L?y tên l?p

For i = 1 To rowCount
If InStr(tkbChung(i, j), "-") > 0 And tkbChung(i, j) <> "" Then
splitData = Split(tkbChung(i, j), "-")
teacherName = Trim(splitData(1))
subjectInfo = Trim(splitData(0)) & "- " & className

' Ki?m tra xem giáo viên dã có trong t? di?n chua
If Not dict.Exists(teacherName) Then
k = k + 1
dict(teacherName) = k

' M? r?ng m?ng k?t qu? n?u c?n
If UBound(resultArr, 2) < k Then ReDim Preserve resultArr(1 To 61, 1 To k)

resultArr(1, k) = teacherName ' Luu tên giáo viên vào hàng d?u tiên
End If

' Gán thông tin vào m?ng k?t qu?
resultArr(i + 1, dict(teacherName)) = subjectInfo
End If
Next i
Next j

' Kiem tra ô T1 có giá tri không
Dim teacherSearch As String
teacherSearch = ws.Range("T1").value

If teacherSearch <> "" Then
Dim lastCol As Integer
lastCol = ws.Cells(4, ws.Columns.Count).End(xlToLeft).Column

' Ði?n d? li?u vào c?t T d?a trên tìm ki?m
For i = 4 To lastRow
ws.Range("T" & i).value = WorksheetFunction.HLookup(teacherSearch, resultArr, i - 2, False)
With ws.Range("T" & i)
.WrapText = False
.Font.Size = 8
.Borders.LineStyle = xlContinuous
End With
Next i
Else
MsgBox "Vui lòng chon Giáo viên!", vbExclamation
End If

Application.ScreenUpdating = True ' B?t l?i c?p nh?t màn hình
End Sub

'---- So sanh TKB hien tai voi TKB duoc chon ----------
Sub SoSanhTKB()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cell1 As Range
Dim cell2 As Range
Dim r1 As Range
Dim cellAddress As String
Dim sheetName As String

' Prompt the user to select a sheet
sheetName = InputBox("Please enter the name of the sheet to extract data from:", "Select Sheet")

' Check if the sheet exists
On Error Resume Next
Set ws2 = ThisWorkbook.Sheets(sheetName)
On Error GoTo 0

' Thi?t l?p sheet dang active và Sheet2

Set ws1 = ActiveSheet

' Vùng c?n so sánh (C4:S34) trong sheet dang active
Set r1 = ws1.Range("C4:S34")

' L?p qua t?t c? các ô trong vùng r1 c?a sheet dang active
For Each cell1 In r1
' L?y d?a ch? ô tuong ?ng trong Sheet2
cellAddress = cell1.Address
Set cell2 = ws2.Range(cellAddress)

' So sánh giá tr? gi?a hai ô
If cell1.value <> cell2.value Then
' N?u khác nhau, tô màu ô trong sheet dang active
cell1.Font.Color = RGB(255, 0, 0) ' Màu d?
End If
Next cell1
MsgBox "OK"
End Sub

Em tự mò học, làm nhưng sao file chạy nặng, hay bị đơ và tự thoát. AC góp ý giúp ah, em cảm ơn