Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As Integer, Rws As Long, J As Long, rMax As Integer
Dim W1 As Integer, W5 As Integer, W9 As Integer, W7 As Integer, W0 As Integer
Dim W3 As Integer, W4 As Integer, W6 As Integer, W8 As Integer, W2 As Integer
Dim Sh As Worksheet, Cls As Range, Rng As Range, Arr()
Const B2_ As Integer = 6: Const D2_ As Double = 1.2
' On Error Resume Next '
If Not Intersect(Target, [A2]) Is Nothing Then
Set Sh = ThisWorkbook.Worksheets("KeHoach")
Rws = Sh.[C2].CurrentRegion.Rows.Count
[A30:AN99].ClearContents
'Tìm Ngày Bát Dàu: '
For Each Cls In Sh.Range(Sh.[h1], Sh.[h1].End(xlToRight))
If Cls.Value = Target.Value Then
Col = Cls.Column: Arr() = Sh.[A2].Resize(Rws, 9 + Col).Value
Exit For
End If
Next Cls
ReDim aKQ0(1 To 99, 1 To 3): ReDim aKQ1(1 To 99, 1 To 2)
ReDim aKQ2(1 To 99, 1 To 2): ReDim aKQ3(1 To 99, 1 To 2)
ReDim aKQ4(1 To 99, 1 To 2): ReDim aKQ5(1 To 99, 1 To 2)
ReDim aKQ6(1 To 99, 1 To 2): ReDim aKQ7(1 To 99, 1 To 2)
ReDim aKQ9(1 To 99, 1 To 2): ReDim aKQ8(1 To 99, 1 To 2)
ReDim aDg(1 To 10, 1 To 1) As Integer
Rows("5:99").Hidden = False: [A5].Resize(95, 40).ClearContents
Application.ScreenUpdating = False
For J = 1 To UBound(Arr())
1 If Arr(J, Col) <> Space(0) Then
aDg(1, 1) = aDg(1, 1) + 1: aKQ0(aDg(1, 1), 1) = Arr(J, 3)
aKQ0(aDg(1, 1), 2) = Arr(J, Col)
aKQ0(aDg(1, 1), 3) = Arr(J, Col) / B2_ / D2_ / 8
End If
2 If (Arr(J, 1 + Col)) <> Space(0) Then
aDg(2, 1) = aDg(2, 1) + 1
aKQ1(aDg(2, 1), 1) = Arr(J, 3)
aKQ1(aDg(2, 1), 2) = Arr(J, 1 + Col)
End If
3 If (Arr(J, 2 + Col)) <> Space(0) Then
aDg(3, 1) = aDg(3, 1) + 1: aKQ2(aDg(3, 1), 1) = Arr(J, 3)
aKQ2(aDg(3, 1), 2) = Arr(J, 2 + Col)
End If
4 If Arr(J, 3 + Col) <> Space(0) Then
aDg(4, 1) = aDg(4, 1) + 1: aKQ3(aDg(4, 1), 1) = Arr(J, 3)
aKQ3(aDg(4, 1), 2) = Arr(J, 3 + Col)
End If
5 If Arr(J, 4 + Col) <> Space(0) Then
aDg(5, 1) = aDg(5, 1) + 1: aKQ4(aDg(5, 1), 1) = Arr(J, 3)
aKQ4(aDg(5, 1), 2) = Arr(J, 4 + Col)
End If
6 If Arr(J, 5 + Col) <> Space(0) Then
aDg(6, 1) = aDg(6, 1) + 1: aKQ5(aDg(6, 1), 1) = Arr(J, 3)
aKQ5(aDg(6, 1), 2) = Arr(J, 5 + Col)
End If
7 If Arr(J, 6 + Col) <> Space(0) Then
aDg(7, 1) = aDg(7, 1) + 1: aKQ6(aDg(7, 1), 1) = Arr(J, 3)
aKQ6(aDg(7, 1), 2) = Arr(J, 6 + Col)
End If
8 If Arr(J, 7 + Col) <> Space(0) Then
aDg(8, 1) = aDg(8, 1) + 1: aKQ7(aDg(8, 1), 1) = Arr(J, 3)
aKQ7(aDg(8, 1), 2) = Arr(J, 7 + Col)
End If
9 If Arr(J, 8 + Col) <> Space(0) Then
aDg(9, 1) = aDg(9, 1) + 1: aKQ8(aDg(9, 1), 1) = Arr(J, 3)
aKQ8(aDg(9, 1), 2) = Arr(J, 8 + Col)
End If
10 If Arr(J, 9 + Col) <> Space(0) Then
aDg(10, 1) = aDg(10, 1) + 1: aKQ9(aDg(10, 1), 1) = Arr(J, 3)
aKQ9(aDg(10, 1), 2) = Arr(J, 9 + Col)
End If
Next J
[A5].Resize(aDg(1, 1), 3) = aKQ0(): [e5].Resize(aDg(2, 1), 2).Value = aKQ1()
[I5].Resize(aDg(3, 1), 2).Value = aKQ2(): [M5].Resize(aDg(4, 1), 2).Value = aKQ3()
[Q5].Resize(aDg(5, 1), 2).Value = aKQ4(): [U5].Resize(aDg(6, 1), 2).Value = aKQ5()
[Y5].Resize(aDg(7, 1), 2).Value = aKQ6(): [AC5].Resize(aDg(8, 1), 2).Value = aKQ7()
[AG5].Resize(aDg(9, 1), 2).Value = aKQ8(): [Ak5].Resize(aDg(10, 1), 2).Value = aKQ9()
'Xác Dinh Dòng Có Du Liêu '
For J = 1 To 10
If aDg(J, 1) > rMax Then rMax = aDg(J, 1)
Next J
Rows(rMax + 6 & ":99").Hidden = True
Application.ScreenUpdating = True
MsgBox "Xong Rôi Nha!", , "GPE.COM Xin Chào! " & rMax
End If
End Sub
