Option Explicit
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
Dim Sh As Worksheet, Rng As Range, sRng As Range
Dim fDat As Date, lDat As Date, Dat As Date
Dim Ngay As Byte, jJ As Byte, Offs As Integer, Timer_ As Double
Dim MyAdd As String
If Not Intersect(Target, [G2]) Is Nothing Then
Timer_ = Timer
Set Sh = ThisWorkbook.Worksheets("PHATSINH")
Set Rng = Sh.Range(Sh.[o10], Sh.[o65500].End(xlUp))
fDat = DateSerial([i2].Value, [G2].Value, 0)
lDat = DateSerial([i2].Value, 1 + [G2].Value, 1)
Rows("10:33").Hidden = False
[a10].Resize(24, 7).ClearContents: [j10:j33].ClearContents
Set sRng = Rng.Find([f3].Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
Dat = sRng.Offset(, -8).Value
If Dat > fDat And Dat < lDat Then
With [A33].End(xlUp).Offset(1)
.Resize(, 2).Value = sRng.Offset(, -9).Resize(, 2).Value
.Offset(, 2).Value = sRng.Offset(, -1).Value
Offs = IIf(sRng.Offset(, -10).Value = "PN", 3, 5)
.Offset(, Offs).Value = sRng.Offset(, 3).Value 'Só Lg'
.Offset(, 1 + Offs).Value = sRng.Offset(, 7).Value 'TTièn'
.Offset(, 9).Value = sRng.Row
End With
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Offs = [b9].End(xlDown).Row + 3
If Offs > 33 Then Offs = 12
Rows(Offs & ":32").Hidden = True
[L65500].End(xlUp).Offset(1).Value = Timer - Timer_
End If
[B]End Sub[/B]
