Private Sub XuLy_Click()
Dim rA1 As Range, rA2 As Range, rR As Range, rC As Range
Dim i As Long, k As Long, J As Long, iR As Long, iC As Long
Dim aSmall As Long, pSmall As Long, DKLap As Boolean
Dim aR(), aC()
With Application
.ScreenUpdating = False
Set rA1 = Me.Range(Me.Name)
iR = rA1.Rows.Count
iC = rA1.Columns.Count
pSmall = rA1(1, 2)
aSmall = -rA1(2, 2)
DKLap = (rA1(3, 2) > 0)
If Not DKLap Then GoTo KetThuc
ReDim aR(1 To iR, 1 To 2)
aR = rA1.Offset(4, 0).Resize(iR - 4, 2)
ReDim aC(1 To 2, 1 To iC)
aC = rA1.Offset(, 2).Resize(2, iC - 2)
'Trich ra nhung phieu co the chuyen '
For i = 1 To iR - 4
If (aR(i, 2) > aC(2, aR(i, 1))) Then
aR(i, 2) = 0
End If
aR(i, 1) = i
Next
Set rA2 = Sheet4.Cells.Resize(iR - 4, 2)
rA2 = aR
Do While (rA1(3, 2) > 0) 'Dieu kien lap con gia tri am'
rA2.Sort key1:=Sheet4.Range("B1"), Header:=xlNo
k = .WorksheetFunction.Match(aSmall, rA2.Offset(, 1).Resize(, 1), 1)
If rA2(k, 2) = 0 Then k = k + 1
If k > iR - 4 Then GoTo KetThuc
rA2(k, 2) = 0
k = rA2(k, 1)
rA1(4 + k, 1) = pSmall
pSmall = rA1(1, 2)
aSmall = -rA1(2, 2)
Loop
KetThuc:
MsgBox "Het kha nang!"
Set rA1 = Nothing
Set rA2 = Nothing
.ScreenUpdating = True
End With
End Sub
