ChanhTQ@
0901452không62
- Tham gia
- 5/9/08
- Bài viết
- 4,256
- Được thích
- 4,863
Vậy tháng trước bạn báo cáo như thế nào?
PHP:
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) = 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, [e6]) Is Nothing Then
GPE Target
GoTo 666666
666666
ElseIf Not Intersect(Target, [e5]) Is Nothing Then
GPE Target
GoTo 555555
555555:
End If
End Sub
PHP:
Sub GPE(Targ As Range)
Dim WF, Sh As Worksheet, Rng As Range, Crit As Range, Cls As Range, nRng As Range
Dim eRw As Long, jJ As Byte, Col As Byte, Cot As Byte
Dim sName As String
Dim DT As Double, CF As Double, LL As Double
Col = Switch(Targ.Row = 5, 3, Targ.Row = 6, 5)
Cot = Switch(Col = 3, 3, Col = 5, 4)
Set Sh = ThisWorkbook.Sheets("CSDL")
[b13].CurrentRegion.EntireRow.Hidden = False
[b13].CurrentRegion.Offset(1, 1).ClearContents
eRw = Sh.[B65500].End(xlUp).Row
Set Rng = Sh.[b2].CurrentRegion
Set WF = Application.WorksheetFunction
If Targ.Value <> "All" Then
If [e4].Value <> "All" Then 'One Month'
With [B200].End(xlUp).Offset(1)
.Value = "'" & Right("0" & [e4].Value, 2) & "/" & [G4].Value
If Col = 3 Then
.Offset(, 3).Value = [g5].Value
.Offset(, 4).Value = Targ.Value
Else
.Offset(, Col).Value = Targ.Value
End If
.Offset(, 6).Value = _
WF.SumIf(Sh.[b1].Offset(, Cot).Resize(eRw), Targ.Offset(, IIf(Col = 3, 2, 0)), Sh.[g1])
.Offset(, 7).Value = _
WF.SumIf(Sh.[b1].Offset(, Cot).Resize(eRw), Targ.Offset(, IIf(Col = 3, 2, 0)), Sh.[h1])
.Offset(, 8).Value = _
WF.SumIf(Sh.[b1].Offset(, Cot).Resize(eRw), Targ.Offset(, IIf(Col = 3, 2, 0)), Sh.[i1])
End With
Else 'All Month'
Sh.[aB1].Value = Sh.[E1].Value: Sh.[aa1] = Sh.[b1]
Sh.[Ab2].Value = Targ.Offset(, IIf(Col = 3, 2, 0)).Value
Set Crit = Sh.[aa1].Resize(2, 2)
For jJ = 1 To 12
Sh.[AA2].Value = jJ
DT = WF.DSum(Rng, Sh.[g1], Crit)
CF = WF.DSum(Rng, Sh.[h1], Crit)
LL = WF.DSum(Rng, Sh.[i1], Crit)
If DT > 0 Or CF > 0 Or LL > 0 Then
With [B200].End(xlUp).Offset(1)
.Value = "'" & Right("0" & jJ, 2) & "/" & [G4].Value
If Col = 3 Then
.Offset(, 3).Value = Targ.Offset(, 2).Value
.Offset(, 4).Value = Targ.Value
Else
.Offset(, Col).Value = Targ.Value
End If
.Offset(, 6).Value = DT
.Offset(, 7).Value = CF
.Offset(, 8).Value = LL
End With
End If
Next jJ
End If
Else
Sh.[aB1].Value = Sh.[E1].Value: Sh.[aa1] = Sh.[b1]
sName = Switch(Col = 3, "MaDT", Col = 5, "MaMH")
If Left([F5], 1) = "T" Then
Set Crit = Sh.[aa1].Resize(2, 2)
For jJ = 1 To 12
Sh.[AA2].Value = jJ
For Each Cls In Sh.Range(sName)
If Cls.Value = "All" Then Exit For
Sh.[Ab2].Value = Cls
DT = WF.DSum(Rng, Sh.[g1], Crit)
CF = WF.DSum(Rng, Sh.[h1], Crit)
LL = WF.DSum(Rng, Sh.[i1], Crit)
If DT > 0 Or CF > 0 Or LL > 0 Then
With [B200].End(xlUp).Offset(1)
.Value = "'" & Right("0" & jJ, 2) & "/" & [G4].Value
.Offset(, Col).Value = Cls.Value
If Col = 3 Then
.Offset(, Col + 1).Value = Sh.Range("MaDT").Find(Cls.Value).Offset(, -1).Value
End If
.Offset(, 6).Value = DT
.Offset(, 7).Value = CF
.Offset(, 8).Value = LL
End With
End If
Next Cls
Next jJ
ElseIf Left([F5], 1) = "C" Then
For Each Cls In Sh.Range(sName)
If Cls.Value = "All" Then Exit For
DT = WF.SumIf(Sh.[b1].Offset(, Cot).Resize(eRw), Cls, Sh.[g1])
CF = WF.SumIf(Sh.[b1].Offset(, Cot).Resize(eRw), Cls, Sh.[h1])
LL = WF.SumIf(Sh.[b1].Offset(, Cot).Resize(eRw), Cls, Sh.[i1])
If DT > 0 Or CF > 0 Or LL > 0 Then
With [B200].End(xlUp).Offset(1)
.Value = "N" & Right([b13], 2) & " " & [G4].Value
.Offset(, Col).Value = Cls.Value
If Col = 3 Then
.Offset(, 4).Value = Sh.Range("MaDT").Find(Cls.Value).Offset(, -1).Value
Else
End If
.Offset(, 6).Value = DT
.Offset(, 7).Value = CF
.Offset(, 8).Value = LL
End With
End If
Next Cls
End If
End If
On Error Resume Next
Range([b13].End(xlDown).Offset(2), [B200]).EntireRow.Hidden = True
End Sub
