Option Explicit
Dim Timer_ As Double
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WF, CF As Worksheet, DT As Worksheet, Cls As Range, Rng As Range, sRng As Range
Dim cRg As Range, Clls As Range, mRg As Range, Crit As Range
Dim MyAdd As String: Dim Col As Byte
Dim ChFi As Double, tDT As Double, tCF As Double, tLL As Double
Set WF = Application.WorksheetFunction: Timer_ = Timer
If Not Intersect(Target, [e4]) Is Nothing Then
Set DT = ThisWorkbook.Worksheets("ChiTietDT")
Set CF = ThisWorkbook.Worksheets("ChiTietCP")
Set Rng = DT.Range(DT.[f9], DT.[f65500].End(xlUp))
Col = DT.[iu8].End(xlToLeft).Column
Sheets("CSDL").[b1].CurrentRegion.Offset(1, 1).ClearContents
For Each Cls In Rng
If ([e4].Value = "All" And Year(Cls.Offset(, -2)) = [G4].Value) Or _
([e4].Value <> "All" And Month(Cls.Offset(, -2)) = [e4].Value _
And Year(Cls.Offset(, -2)) = [G4].Value) Then '*'
If WF.Sum(Cls.Offset(, 1).Resize(, Col)) > 0 Then
Set cRg = CF.Range(CF.[d8], CF.[d65500].End(xlUp))
Set sRng = cRg.Find(Cls.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
If sRng.Offset(, -2).Value = Cls.Offset(, -2).Value Then
ChFi = CF.Cells(sRng.Row, "S"): Exit Do
End If
Set sRng = cRg.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Set mRg = Cls.Offset(, 1).Resize(, Col).SpecialCells(xlCellTypeConstants, 1)
For Each Clls In mRg
If Clls.Value > 0 Then
With Sheets("CSDL").[B65500].End(xlUp).Offset(1)
.Value = Month(Cls.Offset(, -2).Value)
' .Offset(, 1) = Year(Cls.Offset(, -2).Value)'
.Offset(, 1) = Cls.Value
.Offset(, 2) = Cls.Offset(, -1).Value
.Offset(, 3) = Sheets("CSDL").Range("SoXe").Find(Cls.Value).Offset(, 1)
.Offset(, 4) = DT.Cells(8, Clls.Column).Value
.Offset(, 5) = Clls.Value
.Offset(, 7) = Clls.Value - ChFi
If ChFi > 0 Then
.Offset(, 6) = ChFi: ChFi = 0
End If
End With
End If
Next Clls
End If
End If
Next Cls
Set CF = ThisWorkbook.Sheets("CSDL")
[b13].CurrentRegion.EntireRow.Hidden = False
[b13].CurrentRegion.Offset(1, 1).ClearContents
ChFi = CF.[B65500].End(xlUp).Row
If [e4].Value <> "All" Then
With [B200].End(xlUp).Offset(1)
.Value = "'" & Right("0" & [e4].Value, 2) & "/" & [G4].Value
.Offset(, 6).Value = WF.Sum(CF.[g1].Resize(ChFi))
.Offset(, 7).Value = WF.Sum(CF.[h1].Resize(ChFi))
.Offset(, 8).Value = WF.Sum(CF.[i1].Resize(ChFi))
End With
Else
For Col = 1 To 12
tDT = WF.SumIf(CF.[b1].Resize(ChFi), Col, CF.[g1])
tCF = WF.SumIf(CF.[b1].Resize(ChFi), Col, CF.[h1])
tLL = WF.SumIf(CF.[b1].Resize(ChFi), Col, CF.[i1])
If tDT > 0 Or tCF > 0 Or tLL > 0 Then
With [B99].End(xlUp).Offset(1)
.Value = "'" & Right("0" & Col, 2) & "/" & [G4].Value
.Offset(, 6).Value = tDT
.Offset(, 7).Value = tCF
.Offset(, 8).Value = tLL
End With
End If
Next Col
End If
Range([b13].End(xlDown).Offset(2), [B200]).EntireRow.Hidden = True
ElseIf Not Intersect(Target, [e5]) Is Nothing Then
Set CF = ThisWorkbook.Sheets("CSDL")
[b13].CurrentRegion.EntireRow.Hidden = False
[b13].CurrentRegion.Offset(1, 1).ClearContents
ChFi = CF.[B65500].End(xlUp).Row
If [e5].Value <> "All" Then
If [e4].Value <> "All" Then 'One Month'
With [B200].End(xlUp).Offset(1)
.Value = "'" & Right("0" & [e4].Value, 2) & "/" & [G4].Value
.Offset(, 3).Value = [g5].Value
.Offset(, 4).Value = [e5].Value
.Offset(, 6).Value = WF.SumIf(CF.[E1].Resize(ChFi), [g5], CF.[g1])
.Offset(, 7).Value = WF.SumIf(CF.[E1].Resize(ChFi), [g5], CF.[h1])
.Offset(, 8).Value = WF.SumIf(CF.[E1].Resize(ChFi), [g5], CF.[i1])
End With
Else 'All Month'
CF.[aB1].Value = CF.[E1].Value
CF.[Ab2].Value = [g5].Value: CF.[aa1] = CF.[b1]
Set Rng = CF.[b2].CurrentRegion
Set Crit = CF.[aa1].Resize(2, 2)
For Col = 1 To 12
CF.[AA2].Value = Col
tDT = WF.DSum(Rng, CF.[g1], Crit)
tCF = WF.DSum(Rng, CF.[h1], Crit)
tLL = WF.DSum(Rng, CF.[i1], Crit)
If tDT > 0 Or tCF > 0 Or tLL > 0 Then
With [B200].End(xlUp).Offset(1)
.Value = "'" & Right("0" & Col, 2) & "/" & [G4].Value
.Offset(, 3).Value = [g5].Value
.Offset(, 4).Value = [e5].Value
.Offset(, 6).Value = tDT
.Offset(, 7).Value = tCF
.Offset(, 8).Value = tLL
End With
End If
Next Col
End If
Else
CF.[aB1].Value = CF.[E1].Value: CF.[aa1] = CF.[b1]
Set Rng = CF.[b2].CurrentRegion
If Left([F5], 1) = "T" Then
Set Crit = CF.[aa1].Resize(2, 2)
For Col = 1 To 12
CF.[AA2].Value = Col
For Each Cls In CF.Range("MaDT")
If Cls.Value = "All" Then Exit For
CF.[Ab2].Value = Cls
tDT = WF.DSum(Rng, CF.[g1], Crit)
tCF = WF.DSum(Rng, CF.[h1], Crit)
tLL = WF.DSum(Rng, CF.[i1], Crit)
If tDT > 0 Or tCF > 0 Or tLL > 0 Then
With [B200].End(xlUp).Offset(1)
.Value = "'" & Right("0" & Col, 2) & "/" & [G4].Value
.Offset(, 3).Value = Cls.Value
.Offset(, 4).Value = CF.Range("MaDT").Find(Cls.Value).Offset(, -1).Value
.Offset(, 6).Value = tDT
.Offset(, 7).Value = tCF
.Offset(, 8).Value = tLL
End With
End If
Next Cls
Next Col
ElseIf Left([F5], 1) = "C" Then
Set Crit = CF.[ab1:AB2]
For Each Cls In CF.Range("MaDT")
If Cls.Value = "All" Then Exit For
CF.[Ab2].Value = Cls
tDT = WF.DSum(Rng, CF.[g1], Crit)
tCF = WF.DSum(Rng, CF.[h1], Crit)
tLL = WF.DSum(Rng, CF.[i1], Crit)
If tDT > 0 Or tCF > 0 Or tLL > 0 Then
With [B200].End(xlUp).Offset(1)
.Value = "N" & Right([b13], 2) & " " & [G4].Value
.Offset(, 3).Value = Cls.Value
.Offset(, 4).Value = CF.Range("MaDT").Find(Cls.Value).Offset(, -1).Value
.Offset(, 6).Value = tDT
.Offset(, 7).Value = tCF
.Offset(, 8).Value = tLL
End With
End If
Next Cls
End If
End If
Range([b13].End(xlDown).Offset(2), [B200]).EntireRow.Hidden = True
End If
End Sub
