Option Explicit
Dim Song As String
Dim Cls As Range, Sh As Worksheet:
Dim Ngay As Date, MCt As Byte
[B]Sub ThongKe()[/B]
Dim eRw As Long, So0 As Long, Num As Integer, Jj As Byte, FU As Double
Dim Blk As Range, fRg As Range, sRg As Range, Rg0 As Range, tRg As Range
Const KT As String = " "
Sheets("HQL").Select
Set Sh = ThisWorkbook.Worksheets("KQua")
Sh.Columns("A:F").Insert Shift:=xlToRight
Sh.Columns("G:L").Delete Shift:=xlToLeft
eRw = [A65500].End(xlUp).Row
Song = [A1].Value: Set fRg = [A2]
Do
Ngay = fRg.Offset(1).Value: MCt = fRg.Value
If fRg.Row >= eRw Then Exit Do
Set Blk = Range(fRg, fRg.Offset(2, 1).End(xlDown).Offset(, -1))
Set tRg = Blk(1).Offset(Blk.Rows.Count) [COLOR=#0000cd] 'O Cuói Cua Mat Cát'[/COLOR]
Num = Abs(tRg.Offset(-1).Value)
Set sRg = [BA1].Resize(210).Find(Num, , xlFormulas, xlWhole)
If Not sRg Is Nothing Then
Set Rg0 = Sh.[A65500].End(xlUp).Offset(2)
[COLOR=#0000ff]'Chép Tù Form:'[/COLOR]
[BA1].Resize(sRg.Row + 1, 5).Copy Destination:=Rg0
With Rg0
.Value = .Value & KT & Song
.Offset(1).Value = .Offset(1).Value & KT & MCt
.Offset(2).Value = .Offset(2).Value & KT & Ngay
Randomize
.Offset(4).Resize(, 5).Interior.ColorIndex = 34 + 9 * Rnd() \ 1
End With
[COLOR=#0000ff]'Chép Só Lieu Sang KQua:'[/COLOR]
Jj = 3
For Each Cls In Range(fRg.Offset(2), tRg)
Jj = Jj + 2
If Cls.Value = 0 And Cls.Value <> "" Then [COLOR=#0000ff] '*'[/COLOR]
So0 = So0 + 1
If So0 Mod 2 = 1 Then
FU = Cls.Offset(, 1).Value
Else
FU = Abs(Cls.Offset(, 1) - FU)
End If
End If
Rg0.Offset(Jj, 2).Resize(, 2).Value = Cls.Offset(, 1).Resize(, 2).Value
Rg0.Offset(Jj, 4).Value = Cls.Offset(, 4).Value
With Cls.Offset(1, 1)
If .Row < tRg.Row Then _
Rg0.Offset(Jj + 1, 1).Value = Abs(.Offset(-1).Value - .Value)
End With
Next Cls
GPE Sh.[A65500].End(xlUp).Offset(1).Resize(, 5)
With Sh.[A65500].End(xlUp).Offset(1)
.Value = [BG1].Value & KT & CStr(FU) [COLOR=#0000ff] '<=|'[/COLOR]
.Offset(1).Value = [bg2].Value & KT &[COLOR=#ff0000] "???"[/COLOR]
End With
Set fRg = tRg
End If
Loop
Sh.Select: Set Sh = Nothing
[B]End Sub[/B]
