Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet, Rng As Range, Cls As Range
Dim Rws As Long, Col As Byte, Num As Byte
Dim Ma As String: Dim Trung As Boolean '*'
If Not Intersect(Target, [D5]) Is Nothing Then
Set Sh = ThisWorkbook.Worksheets("NKNX")
Rws = Sh.[b6].CurrentRegion.Rows.Count
Set Rng = Sh.[A5].Resize(Rws, 13)
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range( _
"BA1:BB2"), CopyToRange:=Sh.Range("BA5:BH5"), Unique:=False
Sh.[ba6].CurrentRegion.Sort Key1:=Sh.Range("BA6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Rows("9:42").Hidden = False
[c10:bi31].ClearContents
Set Rng = Sh.[bb6].CurrentRegion.Offset(1)
Rws = Sh.[bb7].CurrentRegion.Rows.Count
Application.ScreenUpdating = False
If Rws > 1 Then
For Each Cls In Rng(2).Resize(Rws)
If Cls.Value = "" Then Exit For
With [c31].End(xlUp).Offset(1)
Trung = Cls.Value = Cls.Offset(-1).Value '**=>'
If Trung Then
.Offset(-1, 1).Value = .Offset(-1, 1).Value + Cls.Offset(, 1).Value
Else
.Resize(, 2).Value = Cls.Resize(, 2).Value
End If '<=|*'
Ma = Cls.Offset(, 2).Value
Num = CByte(Right(Ma, 2))
If Num < 13 Then
Col = Num + 4
ElseIf Num < 39 Then
Col = Num - 14
ElseIf Num < 70 Then
Col = Num - 16
Else
Col = Num - 22
End If
Cells(.Row + IIf(Trung, -1, 0), Col).Value = Cls.Offset(, 3).Value + _
Cells(.Row + IIf(Trung, -1, 0), Col).Value '***'
End With
Next Cls
End If
Application.ScreenUpdating = True
Rws = [c9].End(xlDown).Row
If Rws >= 32 Then
Rows("11:30").Hidden = True
Else
Rows(Rws + 9 & ":30").Hidden = True
End If
End If
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet, Rng As Range, Cls As Range
Dim Rws As Long, Col As Byte, Num As Byte
Dim Ma As String: Dim Trung As Boolean
If Not Intersect(Target, [D5]) Is Nothing Then
' Set Sh = ThisWorkbook.Worksheets("NKNX") '
' Rws = Sh.[e7].CurrentRegion.Rows.Count '
Set Sh = ThisWorkbook.Worksheets("NKNX")
Rws = Sh.[c7].CurrentRegion.Rows.Count
5 Set Rng = Sh.[C5].Resize(Rws, 14)
6 Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range( _
"BD1:Bg2"), CopyToRange:=Sh.Range("BD5:Bl5"), Unique:=False '**'
Sh.[bd6].CurrentRegion.Sort Key1:=Sh.Range("Bd6"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Rows("9:112").Hidden = False
[c11:ea31].ClearContents '*'
Set Rng = Sh.[be6].CurrentRegion.Offset(1)
Rws = Sh.[be7].CurrentRegion.Rows.Count
Application.ScreenUpdating = False
If Rws > 1 Then
For Each Cls In Rng(2).Resize(Rws)
If Cls.Value = "" Then Exit For
With [c111].End(xlUp).Offset(1) '7'
Trung = Cls.Value = Cls.Offset(-1).Value
If Trung Then
.Offset(-1, 1).Value = .Offset(-1, 1).Value + Cls.Offset(, 1).Value
Else
.Resize(, 2).Value = Cls.Resize(, 2).Value
End If
Ma = Cls.Offset(, 2).Value
Num = CByte(Right(Ma, 2))
If Num < 13 Then
Col = Num + 4
ElseIf Num < 39 Then
Col = Num - 14
ElseIf Num < 70 Then
Col = Num - 16
Else
Col = Num - 22
End If
Cells(.Row + Trung, Col).Value = _
Cls.Offset(, 3).Value + Cells(.Row + Trung, Col).Value
End With
Next Cls
End If
Application.ScreenUpdating = True
Rws = [c9].End(xlDown).Row
If Rws >= 110 Then
Rows("11:110").Hidden = True
Else
Rows(Rws + 20 & ":110").Hidden = True
End If
End If
End Sub If Not Intersect(Target, [D5]) Is Nothing Then If Not Intersect(Target, [D6]) Is Nothing Then
