Sub GPE()
Dim Darr(), Arr(), Sarr(), StrArr(), Laymau As String, Tmp As String
Dim i As Long, k As Long, j As Byte, iR As Byte, Stt As Integer
With Sheets("Nhattrinh")
Darr = .Range("B17:E" & .Range("C17").End(xlDown).Row).Value
End With
ReDim Arr(1 To UBound(Darr) * 3, 1 To 4)
With Sheets("Danhmuc")
StrArr = .Range("H1:H3").Value ' tam gan ky tu tieng viet co dau
Laymau = .Range("H4").Value
End With
ReDim Sarr(1 To 100, 1 To 5)
For i = 1 To UBound(Darr)
Tmp = Left(Darr(i, 1), 2)
If Tmp = "TC" Or i = UBound(Darr) Then
If Sarr(1, 1) <> "" Then
For iR = 1 To Sarr(100, 1) 'cong viec
Stt = Stt + 1
k = k + 1
Arr(k, 1) = Stt '
For j = 1 To 3
Arr(k, j + 1) = Darr(Sarr(iR, 1), j)
Next j
For j = 1 To 3
k = k + 1
Arr(k, 3) = StrArr(j, 1)
Next j
Next iR
For iR = 1 To Sarr(100, 2) 'kiem tra
k = k + 1
Arr(k, 2) = Darr(Sarr(iR, 2), 1)
Arr(k, 3) = Darr(Sarr(iR, 2), 2)
Next iR
For iR = 1 To Sarr(100, 3) 'mau thi nghiem
k = k + 1
Arr(k, 2) = Darr(Sarr(iR, 3), 1)
Arr(k, 3) = Darr(Sarr(iR, 3), 2)
k = k + 1
Arr(k, 3) = Replace(Arr(k - 1, 3), Laymau, " -KQTN")
Next iR
ReDim Sarr(1 To 100, 1 To 4)
End If
Else
'Sarr luu thu tu dòng cua Darr, cot 1 là cong viec, cot 2 là kiem tra, cot 3 là mau thi nghiem
' dong 100 cua Sarr luu so dong du lieu cua cot tuong ung
If Tmp = "KT" Then
Sarr(100, 2) = Sarr(100, 2) + 1
Sarr(Sarr(100, 2), 2) = i
ElseIf Tmp = "CP" Then
Sarr(100, 3) = Sarr(100, 3) + 1
Sarr(Sarr(100, 3), 3) = i
ElseIf Tmp <> "" Then
Sarr(100, 1) = Sarr(100, 1) + 1
Sarr(Sarr(100, 1), 1) = i
End If
End If
Next i
If k Then Sheets("Danhmuc").Range("A5").Resize(k, 4) = Arr
End Sub[code]