Sub TaoSoCai()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
End With
Dim iRows As Integer
Dim i As Integer, j As Integer
Dim FiDay As Date, LaDay As Date
Dim SoTK As String
'Xoa du lieu
S03.Range("A11:I1000").ClearContents
FiDay = DateSerial(Year(S03.Cells(5, 3)), Month(S03.Cells(5, 3)), Day(S03.Cells(5, 3)))
LaDay = DateSerial(Year(S03.Cells(6, 3)), Month(S03.Cells(6, 3)), Day(S03.Cells(6, 3)))
SoTK = S03.Cells(4, 5).Value
'MsgBox (SoTK)
S01.Select
'dong cuoi co du lieu
iRows = Cells(6, 2).Value + 7
j = 10
'Gan so lieu
For i = 8 To iRows
If Cells(i, 1).Value >= FiDay And Cells(i, 1).Value <= LaDay Then
If Cells(i, 5).Value = SoTK Or Cells(i, 6).Value = SoTK Then
j = j + 1
With S03
.Cells(j, 1).Value = Cells(i, 1).Value
.Cells(j, 2).Value = Cells(i, 2).Value
.Cells(j, 3).Value = Cells(i, 3).Value
.Cells(j, 4).Value = Cells(i, 4).Value
.Cells(j, 5).Value = IIf(Cells(i, 5).Value = SoTK, Cells(i, 6).Value, Cells(i, 5).Value)
.Cells(j, 6).Value = IIf(Cells(i, 5).Value = SoTK, Cells(i, 7).Value, "")
.Cells(j, 7).Value = IIf(Cells(i, 6).Value = SoTK, Cells(i, 7).Value, "")
End With
End If
End If
Next i
'Dong tong cong
S03.Select
Cells(j + 1, 6).Value = WorksheetFunction.Sum(Range(Cells(11, 6), Cells(j, 6)))
Cells(j + 1, 7).Value = WorksheetFunction.Sum(Range(Cells(11, 7), Cells(j, 7)))
Cells(j + 1, 6).Font.Bold = True
Cells(j + 1, 7).Font.Bold = True
Cells(j + 2, 6).Value = WorksheetFunction.Max(0, Cells(10, 6).Value + Cells(j + 1, 6).Value - Cells(j + 1, 7).Value)
Cells(j + 2, 7).Value = WorksheetFunction.Max(0, Cells(10, 7).Value + Cells(j + 1, 7).Value - Cells(j + 1, 6).Value)
Cells(j + 1, 6).Font.Bold = True
Cells(j + 1, 7).Font.Bold = True
Cells(j + 2, 6).Font.Bold = True
Cells(j + 2, 7).Font.Bold = True
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
