Sub DangKyHang()
'xac dinh dong cuoi, cot cuoi
rc = Cells(1, 1).End(xlDown).Row
cc = Cells(1, 1).End(xlToRight).Column
If Left(Cells(1, cc - 1), 3) <> "SL " Or Left(Cells(1, cc), 5) <> "Code " Then Exit Sub
Range(Cells(2, cc - 1), Cells(rc, cc)).ClearContents
Columns("IT:IV").ClearContents
'Loc du lieu thoa man sluong <=100
rmin = 1
For r = 2 To rc
For c = 2 To cc - 2
If Cells(r, c) <> "" And Cells(r, c) <= 100 Then
Cells(rmin, 254) = r
Cells(rmin, 255) = Cells(r, c)
Cells(rmin, 256) = c
rmin = rmin + 1
End If
Next
Next
'Sap xep sluong tu nho den lon
Columns("IT:IV").Sort Key1:=Range("IT1"), Order1:=xlAscending, Key2:=Range("IU1"), _
vHeader:=xlNo, OrderCustom:=1
'Ghi du lieu vao 2 cot "SL can dat" va "Code hang can dat"
rc = Cells(1, 256).End(xlDown).Row
rsl = 2
dong = Cells(1, 254)
r = 1
Do While Cells(r, 254) <> ""
If Cells(r, 254) = dong Then
Cells(dong, cc - 1) = Cells(dong, cc - 1) & Cells(r, 255) & ", "
Cells(dong, cc) = Cells(dong, cc) & Cells(1, Cells(r, 256)) & ", "
r = r + 1
Else
If Cells(dong, cc - 1) <> "" Then Cells(dong, cc - 1) = Left(Cells(dong, cc - 1), Len(Cells(dong, cc - 1)) - 2)
If Cells(dong, cc) <> "" Then Cells(dong, cc) = Left(Cells(dong, cc), Len(Cells(dong, cc)) - 2)
dong = Cells(r, 254)
End If
Loop
If Cells(dong, cc - 1) <> "" Then Cells(dong, cc - 1) = Left(Cells(dong, cc - 1), Len(Cells(dong, cc - 1)) - 2)
If Cells(dong, cc) <> "" Then Cells(dong, cc) = Left(Cells(dong, cc), Len(Cells(dong, cc)) - 2)
Columns("IT:IV").ClearContents
Cells(1, cc - 1).Select
End Sub