Sub NKC()
Dim sArr(), Res()
Dim i As Long, k As Long, sRowNo As Long, fRow As Long
Dim jNhieu As Byte, jDU As Byte
Dim ST As Double, tkNo As String, tkCo As String, tkDU As String
Application.ScreenUpdating = False
With Sheets("NKC2")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 3 Then .Range("A4:F" & i).Clear
If i > 2 Then .Range("A3:F3").ClearContents
End With
With Sheets("NKC1")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
sArr = .Range("A2:F" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Value
End With
ReDim Res(1 To UBound(sArr), 1 To 6)
For i = 2 To UBound(sArr) - 1
If sArr(i, 1) <> sArr(i - 1, 1) Then fRow = i
If sArr(i, 5) > 0 Then
sRowNo = sRowNo + 1
tkNo = sArr(i, 4)
Else
tkCo = sArr(i, 4)
End If
If sArr(i, 1) <> sArr(i + 1, 1) Then
If sRowNo = 1 Then
jNhieu = 6: jDU = 4: tkDU = tkNo
Else
jNhieu = 5: jDU = 5: tkDU = tkCo
End If
sRowNo = 0
For n = fRow To i
ST = sArr(n, jNhieu)
If ST > 0 Then
k = k + 1
Res(k, 1) = sArr(n, 1): Res(k, 2) = sArr(n, 2)
Res(k, 3) = sArr(n, 3): Res(k, 6) = ST
Res(k, jNhieu - 1) = sArr(n, 4): Res(k, jDU) = tkDU
End If
Next n
End If
Next i
With Sheets("NKC2")
If k Then
.Range("A3:F3").Resize(k) = Res
If k > 1 Then
.Range("A3:F3").Copy
.Range("A3:F3").Resize(k).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End If
End If
End With
Application.ScreenUpdating = True
End Sub