Chạy code vba để tạo bảng biểu bị treo (1 người xem)

[bee111]

Chào bác Sa_DQ, chào tất cả anh chị em trên diễn đàn. Tôi có đoạn code để tạo bảng biểu trên Excel nhưng mỗi bảng chỉ chạy được đến dòng 99 còn lớn hơn số dòng trên thì không chạy được. mong bác Sa_DQ và các cao thủ xem giúp. Tôi có gửi file kèm theo. đoạn code như sau:

Option Explicit
Dim Song As String
Dim Cls As Range, Sh As Worksheet
Dim Ngay As Date, MCt As Byte
Sub ThongKe()
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 = " ": Dim Sht As Worksheet

For Each Sht In ThisWorkbook.Worksheets
If Left(Sht.Name, 3) = "HQL" Then
MCt = MsgBox(Sht.Name, 1, "Ban Càn Trang Tính Này:")
If MCt = 1 Then Exit For
End If
Next Sht
Sht.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 Sht = ThisWorkbook.Worksheets("GPE")
Set RgC = Sht.[BA1].Resize(210).Find(SoC, , xlFormulas, xlWhole) '*'
If Not RgC Is Nothing Then
Set RgD = Sh.[A65500].End(xlUp).Offset(2)
'Chép Tù Form:'
Sht.[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 & Format$(Ngay, "dd/mm/yyyy")
.Offset(4).Resize(2 * Blk.Rows.Count - 1, 5).Interior.ColorIndex = 34 + MCt Mod 9
End With
'Chép Só Lieu Sang KQua:'
Jj = 3
For Each Cls In Range(fRg.Offset(2), tRg)
Jj = Jj + 2
If Jj = 5 Then FC = FC - Cls.Offset(, 1).Value
If Cls.Value = 0 And Cls.Value <> "" Then
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 = Sht.[BG1].Value & KT & CStr(FU) '<=|*'
.Offset(1).Value = Sht.[bg2].Value & KT & CStr(FC - FU) '<=|*'
End With
Set fRg = tRg
End If
Loop
Sh.Select: Set Sh = Nothing
End Sub
Sub GPE(Rng As Range) 'Ke Dòng Cuói Cua Bang'
With Rng.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End Sub

 

[bee111]

Tôi đã thay đổi số dòng kẻ bảng trong sheet "GPE" lên 450 dòng, và tăng Resize từ 210 lên 800:
Set RgC = Sht.[BA1].Resize(800).Find(SoC, , xlFormulas, xlWhole) '*'

Nhưng khi chạy vẫn báo lỗi ở dòng :
Jj = Jj + 2
Và ở sheet KQua số liệu chỉ chạy ra được đến dòng 127 của bảng 1 là dừng.
Mong bác Sa_DQ và các cao thủ giúp tôi với. Tôi xin cảm ơn nhiều

 

[hoangvuluan]

Bạn đổi kiểu biến Jj từ Byte sang Long và thử lại xem sao.