[Cần giúp đỡ] Tạo subtotal tự động ở trang in bằng VBA

anhthuc_lhx · Đăng lúc 6/3/2019 15:25

Hãy đăng nhập để có nhiều chức năng hữu dụng hơn và xem ảnh rõ hơn!

Bạn phải đăng nhập để xem được nội dung, nếu bạn chưa có tài khoản? hãy Đăng ký mới

x

Chào mọi người. Em đang tìm hiểu VBA. Hiện e đang tham khảo và chỉnh sửa 1 code trong 1file excel mẫu mà kết quả tạo thành subtotal kết thúc mỗi trang in trong bảng tính nhiều trang và nhiều sheet. Do em với tìm hiểu về VBA, nên còn lỗi. Đó là:
- Khi em tạo subtotal cuối trang (bao gồm 2 dòng trống và 1 dòng chứa subtotal) thì 1 dòng trắng nhảy qua trang sau.
- Khi em remove subtotal cuối trang khi e muốn chỉnh sửa thì chỉ xóa được 1 dòng subtotal nhưng không thể xóa được 2 dòng trắng kia.
Nhờ mọi người xem giúp lỗi giúp em vì e đang cần sử dụng cho dự án. Anh chị nào có file mẫu cho em xin, em rất cảm ơn ạ.

[Visual Basic] 纯文本查看 复制代码

Option Explicit

Public Sub AddFooterX()
Application.ScreenUpdating = False
Dim myPage As HPageBreak, iP As Integer, iRb As Integer, iRe As Integer, nRbt As Integer, iReE As Integer
Dim nP As Integer
Dim myviewmode, mysheet
    mysheet = ActiveSheet.Name
    myviewmode = ActiveWindow.View
With Sheets(mysheet).Range("A13")
    Sheets(mysheet).Cells.RemoveSubtotal
End With

iRb = TEMP.Range("DongBatDau").Value
iReE = TEMP.Range("DongCuoiCung").Value + 1
nRbt = TEMP.Range("CONGHETTRANG").Rows.Count
With Sheets(mysheet)
    nP = .HPageBreaks.Count
    .Range("A" & iReE).Value = 1
    .Range("A" & iReE + 1 & ":A" & (iReE + nP * nRbt)).Formula = "=R[-1]C+1"

    iP = 0
End With
With Sheets(mysheet)

For iP = 1 To nP + 1
    If iP <= nP Then
        iRe = Sheets(mysheet).HPageBreaks(iP).Location.Row - nRbt + 1
        TEMP.Range("CONGHETTRANG").Copy
    Else
        iRe = nP * nRbt + TEMP.Range("DongCuoiCung").Value + 1
        TEMP.Range("CongTrangCuoi").Copy
    End If
    Rows(iRe).Insert xlShiftDown, True


    
    .Range("F" & iRe + 1).Formula = "=SUBTOTAL(9,F" & TEMP.Range("DongBatDau").Value & ":F" & (iRe - 1) & ")"
    .Range("G" & iRe + 1).Formula = "=SUBTOTAL(9,G" & TEMP.Range("DongBatDau").Value & ":G" & (iRe - 1) & ")"
    If iP <= nP Then
        .Range("F" & (iRe + nRbt - 1)).Formula = .Range("F" & (iRe + 1)).Formula
        .Range("G" & (iRe + nRbt - 1)).Formula = .Range("G" & (iRe + 1)).Formula
    Else
        .Range("F" & iRe + 2).Formula = "=F" & TEMP.Range("DongBatDau").Value - 1 & "+F" & (iRe + 1) _
                                            & "-G" & TEMP.Range("DongBatDau").Value - 1 & "-G" & (iRe + 1)
        If .Range("F" & iRe + 2).Value < 0 Then
            .Range("G" & iRe + 2).Formula = "=-F" & TEMP.Range("DongBatDau").Value - 1 & "-F" & (iRe + 1) _
                                            & "+G" & TEMP.Range("DongBatDau").Value - 1 & "+G" & (iRe + 1)
            .Range("F" & iRe + 2).ClearContents
        End If
    
    End If
    iRb = iRe + nRbt
Next iP
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


Public Sub XoaFooterX()
Dim mysheet
    mysheet = ActiveSheet.Name
With Sheets(mysheet)
    Application.ScreenUpdating = False
    .Range("A13").Select
    .Cells.RemoveSubtotal
    Application.ScreenUpdating = True
 End With
End Sub

anhthuc_lhx · Đăng lúc 14/3/2019 09:30

Mọi người ơi, giúp em với ạ

Tài khoản		Ghi nhớ?	Quên mật khẩu
Mật khẩu			Đăng ký mới