Private Sub Worksheet_Change(ByVal Target As Range)
Dim sPS As Worksheet, sTT As Worksheet, sThe As Worksheet, sTemp As Worksheet
Dim rPS As Range, rTT As Range, rThe As Range, rTemp As Range, rMaKH As Range
Dim iR As Long, iR2 As Long, aKQ()
Set rMaKH = Me.Range("MaKH")
If Intersect(Target, rMaKH) Is Nothing Then Exit Sub
If rMaKH = "" Then Exit Sub
With Application
.ScreenUpdating = False
Set sPS = Worksheets("Phat_sinh")
Set rPS = sPS.Range("Phat_sinh")
Set sTT = Worksheets("Tra_tien")
Set rTT = sTT.Range("Tra_tien")
Set sThe = Worksheets("TheKN")
Set rThe = sThe.Range("TheKN")
Set sTemp = Worksheets("Temp")
Set rTemp = sTemp.Range("A1")
sTemp.Cells.ClearContents
sPS.AutoFilterMode = False
rPS.AutoFilter field:=1, Criteria1:=rMaKH
rPS.SpecialCells(xlCellTypeVisible).Copy
rTemp.PasteSpecial (xlPasteValues)
Set rTemp = rTemp.End(xlDown).Offset(1)
rTemp.PasteSpecial (xlPasteValues)
rTemp.Rows(1).EntireRow.Delete
Set rTemp = sTemp.Range("A1").CurrentRegion
iR = rTemp.Rows.Count
rTemp.Range("E2:E" & ((iR + 1) / 2)).Copy _
rTemp.Range("D2:D" & ((iR + 1) / 2))
rTemp.Range("E2:E" & iR).ClearContents
For i = 2 To (iR + 1) / 2
sTemp.Cells(i, 7) = sTemp.Cells(i, 7) & "-VC"
Next
For i = 1 + ((iR + 1) / 2) To iR
sTemp.Cells(i, 7) = sTemp.Cells(i, 7) & "-TD"
Next
Set rTemp = sTemp.Range("A1").End(xlDown).Offset(1)
sTT.AutoFilterMode = False
rTT.AutoFilter field:=1, Criteria1:=rMaKH
rTT.SpecialCells(xlCellTypeVisible).Copy
rTemp.PasteSpecial (xlPasteValues)
Set rTemp = rTemp.End(xlDown).Offset(1)
rTemp.PasteSpecial (xlPasteValues)
rTemp.Rows(1).EntireRow.Delete
sTemp.Rows(iR + 1).EntireRow.Delete
Set rTemp = sTemp.Range("A1").CurrentRegion.Offset(iR)
iR2 = rTemp.Rows.Count
sTemp.Range("D" & (iR + 1) & ":D" & ((iR2 - iR) / 2 + iR)).Copy _
sTemp.Range("E" & (iR + 1) & ":E" & ((iR2 - iR) / 2 + iR))
sTemp.Range("D" & (iR + 1) & ":D" & iR2).ClearContents
For i = iR + 1 To (iR2 - iR) / 2 + iR
sTemp.Cells(i, 7) = sTemp.Cells(i, 7) & "-TD"
Next
For i = 1 + ((iR2 - iR) / 2) + iR To iR2
sTemp.Cells(i, 7) = sTemp.Cells(i, 7) & "-VC"
Next
sTemp.Activate
Set rTemp = sTemp.Range("A1").CurrentRegion
rTemp.Sort key2:=rTemp.Range("G1"), key1:=rTemp.Range("F1"), key3:=rTemp.Range("D1"), order3:=xlDescending, Header:=xlYes
rTemp.Cells(1).Select
For i = iR2 To 2 Step -1
If Trim(rTemp.Cells(i, 4)) = "" And Trim(rTemp.Cells(i, 5)) = "" Then
rTemp.Cells(i, 1).EntireRow.Delete
End If
Next
rTemp.Columns(6).Copy rTemp.Columns(3)
rTemp.Columns(1).EntireColumn.Delete
iR = rTemp.Rows.Count
With rTemp.Offset(1, 0).Resize(iR - 1).Columns(5)
.Formula = "= C2 - D2 + max(E1)"
.Value = .Value
End With
rTemp.Cells(1, 1).EntireRow.Delete
sThe.AutoFilterMode = False
With rThe
.Cells.ClearContents
.Cells(1, 2) = "NgayThang"
rTemp.Copy
.Cells(2, 1).PasteSpecial (xlPasteValues)
.AutoFilter field:=2, Criteria1:="<>"
.Rows(1).EntireRow.Hidden = True
End With
sThe.Activate
rMaKH.Select
Set sPS = Nothing
Set rPS = Nothing
Set sTT = Nothing
Set rTT = Nothing
Set sThe = Nothing
Set rThe = Nothing
Set sTemp = Nothing
Set rTemp = Nothing
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
chắc giờ hết cần rồi.
