Sub mycode()
Dim i, erow3 As Integer
Dim N1, N2, N3 As String
Dim sttN1, sttN2, sttN3 As Integer
Application.ScreenUpdating = False
Range(Cells(27, "A"), Cells(Rows.Count, "A")).EntireRow.Delete shift:=xlUp 'Xoa du lieu cu
erow3 = Cells(Rows.Count, "B").End(xlUp).Row
Range(Cells(1, "A"), Cells(erow3, "I")).Copy Cells(27, "A") 'Copy du lieu chua xu ly vao o A27
erow3 = Cells(Rows.Count, "B").End(xlUp).Row
Range("A28").FormulaR1C1 = "=CONCATENATE(RC[6],RC[7],RC[8])" 'Tao SortKey
Range("A28").Copy Range(Cells(28, "A"), Cells(erow3, "A")) 'Tao SortKey
'Doan nay la y tuong cua Bac NDU
Range("A28:I" & erow3).Sort _
Key1:=Range("A28"), Key1:=Range("B28"), DataOption2:=xlSortTextAsNumbers
Range("A28:A" & erow3).Value = Evaluate("Row(R1:R" & erow3 & ")")
''''''
i = 28
Do While i <= erow3
If Cells(i, "G") <> "" And Cells(i, "G") <> N1 Then
N1 = Cells(i, "G")
sttN1 = sttN1 + 1
sttN2 = 0
sttN3 = 0
Cells(i, "G").EntireRow.Insert shift:=xlDown
Cells(i, "A") = Chr(sttN1 + 64) & ". " & N1
Cells(i, "G") = N1
Range("A" & i & ":B" & i).HorizontalAlignment = xlLeft
Range("A" & i & ":B" & i).Font.FontStyle = "Bold"
Range("A" & i & ":F" & i).Interior.ColorIndex = 8 'Mau xanh coban
erow3 = erow3 + 1
End If
If Cells(i, "H") <> "" And Cells(i, "H") <> N2 Then
N2 = Cells(i, "H")
sttN2 = sttN2 + 1
sttN3 = 0
Cells(i, "H").EntireRow.Insert shift:=xlDown
Cells(i, "A") = Chr(sttN1 + 64) & "." & sttN2 & ". " & N2
Cells(i, "H") = N2
Range("A" & i & ":B" & i).HorizontalAlignment = xlLeft
Range("A" & i & ":B" & i).Font.FontStyle = "Bold" ' "Bold Italic"
Range("A" & i & ":F" & i).Interior.ColorIndex = 40 'Mau nau nhat
erow3 = erow3 + 1
End If
If Cells(i, "I") <> "" And Cells(i, "I") <> N3 Then
N3 = Cells(i, "I")
sttN3 = sttN3 + 1
Cells(i, "I").EntireRow.Insert shift:=xlDown
Cells(i, "A") = Chr(sttN1 + 64) & "." & sttN2 & "." & sttN3 & ". " & N3
Cells(i, "I") = N3
Range("A" & i & ":B" & i).HorizontalAlignment = xlLeft
Range("A" & i & ":B" & i).Font.FontStyle = "Bold" '"Italic"
Range("A" & i & ":F" & i).Interior.ColorIndex = 36 'Mau vang nhat
erow3 = erow3 + 1
End If
If Cells(i + 1, "G") = N1 Then Cells(i + 1, "G") = ""
If Cells(i + 1, "H") = N2 Then Cells(i + 1, "H") = ""
If Cells(i + 1, "I") = N3 Then Cells(i + 1, "I") = ""
i = i + 1
Loop
If WorksheetFunction.CountA(Range("G28:G" & erow3)) = 1 Then _
Range("G28:G" & erow3).SpecialCells(xlCellTypeConstants).EntireRow.Delete shift:=xlUp
If WorksheetFunction.CountA(Range("H28:H" & erow3)) = 1 Then _
Range("H28:H" & erow3).SpecialCells(xlCellTypeConstants).EntireRow.Delete shift:=xlUp
If WorksheetFunction.CountA(Range("I28:I" & erow3)) = 1 Then _
Range("I28:I" & erow3).SpecialCells(xlCellTypeConstants).EntireRow.Delete shift:=xlUp
Range("G27:I" & erow3).ClearContents
Application.ScreenUpdating = True
End Sub
