Sub QuangHai()
Dim data(), i, ii, j, k, Res(1 To 10000, 1 To 6)
With Sheet1
data = .Range(.[B3], .[G65536].End(3).Offset(1)).Value
End With
i = 1
Do
If data(i, 4) <> "" Then
Do
j = j + 1
If data(i + j, 5) <> "" Then
k = k + 1
Res(k, 1) = data(i, 1)
Res(k, 2) = data(i, 2)
Res(k, 3) = data(i, 3)
If data(i + ii, 4) = data(i + j, 5) Then
Res(k, 6) = data(i + j, 5)
Res(k, 5) = data(i + j, 6)
If data(i + ii, 5) = "" Then
Res(k, 4) = data(i, 6)
Else
Res(k, 4) = data(i + ii - 1, 6)
End If
ElseIf data(i + ii, 4) > data(i + j, 5) Then
data(i + ii + 1, 4) = data(i + ii + 1, 4) + data(i + ii, 4) - data(i + j, 5)
Res(k, 6) = data(i + j, 5)
Res(k, 5) = data(i + j, 6)
If data(i + ii - 1, 4) = data(i + j - 1, 5) Then
Res(k, 4) = data(i + ii, 6)
Else
If data(i + ii - 1, 4) - data(i + j - 1, 5) > 0 Then
Res(k, 4) = data(i + ii - 1, 6)
Else
Res(k, 4) = data(i + ii, 6)
End If
End If
ElseIf data(i + ii, 4) < data(i + j, 5) Then
data(i + ii + 1, 4) = data(i + ii + 1, 4) + data(i + ii, 4) - data(i + j, 5)
Res(k, 6) = data(i, 4)
Res(k, 5) = data(i + j, 6)
Res(k, 4) = data(i, 6)
Res(k + 1, 4) = data(i + 1, 6)
Res(k + 1, 5) = data(i + j, 6)
Res(k + 1, 6) = data(i + j, 5) - data(i, 4)
Res(k + 1, 1) = data(i, 1)
Res(k + 1, 2) = data(i, 2)
Res(k + 1, 3) = data(i, 3)
k = k + 1
End If
ii = ii + 1
End If
Loop Until data(i + j, 2) <> data(i + j - 1, 2)
End If
i = i + j
j = 0
ii = 0
Loop Until i >= UBound(data)
Sheet2.[H3].Resize(k, 6) = Res
End Sub
