Sub LocTenLop()
On Error Resume Next
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
Dim DataArr As Variant, c As Long, r As Long, h As Long
Dim ClassArr As Variant, Itm As Variant, FilterArr As Variant
Dim SheetName As String
r = Sheets("K50").Range("B65536").End(xlUp).Row
With Sheets("K50").Range("A3:
J" & r)
.Sort Sheets("K50").[D3], 1, Sheets("K50").[C3], , 1, , , xlYes
DataArr = .Value
ClassArr = NewUnique2DArray(Sheets("K50").Range("D4
" & r).Value)
.Sort Sheets("K50").[A3], 1, , , , , , xlYes
End With
For Each Itm In ClassArr
SheetName = UCase(FontConverter(Itm, UNI, LoaiDau))
SheetName = Replace(SheetName, "BUU CHINH VIEN THONG", "BCVT")
SheetName = Replace(SheetName, "GIAO THONG VAN TAI", "GTVT")
SheetName = Replace(SheetName, "DAN DUNG", "DD")
SheetName = Replace(SheetName, "GIAO THONG", "GT")
SheetName = Replace(SheetName, "VAN TAI", "VT")
SheetName = Replace(SheetName, "CONG NGHIEP", "CN")
SheetName = Replace(SheetName, "QUAN LY", "QL")
SheetName = WorksheetFunction.Trim(Replace(SheetName, "XAY DUNG", "XD"))
SheetName = Replace(SheetName, " ", "_")
If SheetExist(SheetName) Then
Sheets(SheetName).Cells.Clear
Else
Sheets.Add
ActiveSheet.Move After:=Sheets(Sheets.Count)
ActiveSheet.Name = SheetName
End If
FilterArr = Filter2DArray(DataArr, 4, Itm, True)
h = UBound(FilterArr)
With Sheets(SheetName)
.Select
.Range("A3").Resize(h, 10).Value = FilterArr
Sheets("K50").Cells.Copy
.Cells.PasteSpecial Paste:=xlPasteFormats
.Range("A4") = 1
.Range("A4").AutoFill Destination:=Range("A4:A" & h + 2), Type:=xlFillSeries
.Range("A1").Select
End With
Next
Sheets("K50").Select
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
)
