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, SoC As Integer, Jj As Byte, FU As Double, FC As Double
Dim Blk As Range, fRg As Range, RgC As Range, RgD 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
FC = fRg.Offset(2, 1).End(xlDown).Value
Set Blk = Range(fRg, fRg.Offset(2, 1).End(xlDown).Offset(, -1))
Set tRg = Blk(1).Offset(Blk.Rows.Count) 'O Cuói Cua Mat Cát'
SoC = Abs(tRg.Offset(-1).Value)
Set RgC = [BA1].Resize(210).Find(SoC, , xlFormulas, xlWhole)
If Not RgC Is Nothing Then
Set RgD = Sh.[A65500].End(xlUp).Offset(2)
[COLOR=#0000ff]'Chép Tù Form:'[/COLOR]
[BA1].Resize(RgC.Row + 1, 5).Copy Destination:=RgD
With RgD
.Value = .Value & KT & Song
.Offset(1).Value = .Offset(1).Value & KT & MCt
.Offset(2).Value = .Offset(2).Value & KT & Ngay
Randomize
.Offset(4).Resize(2 * Blk.Rows.Count - 1, 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 Jj = 5 Then FC = FC - Cls.Offset(, 1).Value[COLOR=#0000ff] '?'[/COLOR]
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
RgD.Offset(Jj, 2).Resize(, 2).Value = Cls.Offset(, 1).Resize(, 2).Value
RgD.Offset(Jj, 4).Value = Cls.Offset(, 4).Value
With Cls.Offset(1, 1)
If .Row < tRg.Row Then _
RgD.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 & CStr(FC - FU)
End With
Set fRg = tRg
End If
Loop
Sh.Select: Set Sh = Nothing
[B]End Sub[/B]
