In bảng tính trong một trang A4 (6 người xem)

[bongmaihung]

Em có một bảng phân bổ chi phí trả trước. Giờ em muốn in từng bảng phân bổ này tự động vào một trang A4 (mỗi một bảng phân bổ là một trang A4).
Em chưa biết phải làm thế nào. Nhờ anh chị giúp ah
Liệu có phải dùng code VBA HpageBreaks ngắt trang không ah
Chi tiết em gửi file đính kèm

 

[bongmaihung]

Sub NgatTrang()
Dim rc As Long, stt As Integer
' Macro recorded 08/07/2008 by Pham Duy Long
Sheets("DanhSach").Select
ActiveSheet.ResetAllPageBreaks
rc = Cells(Cells.Rows.Count, 1).End(xlUp).Row
stt = Cells(2, 1)
For r = 2 To rc
  If Cells(r, 1) <> stt Then
    ActiveSheet.HPageBreaks.Add Before:=Cells(r, 1)
    stt = Cells(r, 1)
  End If
Next
End Sub

Đây là đoạn code em sưu tầm ở GPE nhưng chưa phù hợp với bài em ah
Nhờ anh chị viết giúp em một đoạn code để thực hiện được yêu cầu nói trên ah

 

[bongmaihung]

Sub NgatTrang()
Dim rc As Long, stt As Integer
Sheets("sheet1").Select
ActiveSheet.ResetAllPageBreaks
rc = Cells(Cells.Rows.Count, 2).End(xlUp).Row
stt = Cells(1, 2)
For r = 7 To rc
  If Cells(r, 2) = stt Then
    ActiveSheet.HPageBreaks.Add Before:=Cells(r, 2)
    stt = Cells(r, 2)
  End If
Next
End Sub

Ở ô B1 em để tên : Người lập biểu

Em sửa thế này nhưng chưa được, không biêt có phải do trộn ô không ah

 

[canguocs]

Sub NgatTrang()
Dim rc As Long, stt As Integer
Sheets("sheet1").Select
ActiveSheet.ResetAllPageBreaks
rc = Cells(Cells.Rows.Count, 2).End(xlUp).Row
stt = Cells(1, 2)
For r = 7 To rc
  If Cells(r, 2) = stt Then
    ActiveSheet.HPageBreaks.Add Before:=Cells(r, 2)
    stt = Cells(r, 2)
  End If
Next
End Sub

Ở ô B1 em để tên : Người lập biểu

Em sửa thế này nhưng chưa được, không biêt có phải do trộn ô không ah

http://www.giaiphapexcel.com/forum/...nhanh-trang-in-Excel-luôn-vừa-khít-trang-giấy
Bạn xem thử đường link này xem

 

[Zerothink]

Sub NgatTrang()
Dim rc As Long, stt As Integer
Sheets("sheet1").Select
ActiveSheet.ResetAllPageBreaks
rc = Cells(Cells.Rows.Count, 2).End(xlUp).Row
stt = Cells(1, 2)
For r = 7 To rc
  If Cells(r, 2) = stt Then
    ActiveSheet.HPageBreaks.Add Before:=Cells(r, 2)
    stt = Cells(r, 2)
  End If
Next
End Sub

Ở ô B1 em để tên : Người lập biểu

Em sửa thế này nhưng chưa được, không biêt có phải do trộn ô không ah

bạn sửa lại SUB thế này

Sub NgatTrang()
Dim rc As Long, stt As String ''Integer
Sheets("sheet1").Select
ActiveSheet.ResetAllPageBreaks
rc = Cells(Cells.Rows.Count, 2).End(xlUp).Row
stt = "STT"
ActiveSheet.ResetAllPageBreaks
For r = 8 To rc
  If Cells(r, 1) = stt Then
    ActiveSheet.HPageBreaks.Add Before:=Cells(r, 1).Offset(-3)
    ''stt = Cells(r, 2)
  End If
Next
End Sub

Tại sao thế, bạn tự so sánh xem khác biệt cái gì thì rút ra được câu trả lời

Tuy vậy, cách nhanh hơn là dùng phương thức FIND của RANGE (tự tìm trên diễn đàn) thì nhanh hơn (nếu tổng số dòng dữ liệu trong sheet không nhiều thì tạm dùng SUB kia cũng được)

 

[bongmaihung]

bạn sửa lại SUB thế này

Sub NgatTrang()
Dim rc As Long, stt As String [COLOR=#0000cd]''Integer[/COLOR]
Sheets("sheet1").Select
ActiveSheet.ResetAllPageBreaks
rc = Cells(Cells.Rows.Count, 2).End(xlUp).Row
stt = "STT"
ActiveSheet.ResetAllPageBreaks
For r = 8 To rc
  If Cells(r, 1) = stt Then
    ActiveSheet.HPageBreaks.Add Before:=Cells(r, 1).Offset(-3)
    [COLOR=#0000cd]''stt = Cells(r, 2)[/COLOR]
  End If
Next
End Sub

Tại sao thế, bạn tự so sánh xem khác biệt cái gì thì rút ra được câu trả lời

Tuy vậy, cách nhanh hơn là dùng phương thức FIND của RANGE (tự tìm trên diễn đàn) thì nhanh hơn (nếu tổng số dòng dữ liệu trong sheet không nhiều thì tạm dùng SUB kia cũng được)

Cảm ơn anh nhé, em đã test thử thành công, em chưa học code chỉ xem bài mẫu trên GPE thôi
Em chưa hiểu đoạn màu xanh lắm, đặc biệt là xanh ở dưới. Nếu cột 1 =stt thì lùi 3 dòng thành bảng phân bổ sẽ được ngắt thì dấu '' stt=Cells(r,2) có ý nghĩa thế nào ah

 

[Zerothink]

Cảm ơn anh nhé, em đã test thử thành công, em chưa học code chỉ xem bài mẫu trên GPE thôi
Em chưa hiểu đoạn màu xanh lắm, đặc biệt là xanh ở dưới. Nếu cột 1 =stt thì lùi 3 dòng thành bảng phân bổ sẽ được ngắt thì dấu '' stt=Cells(r,2) có ý nghĩa thế nào ah

Có dấu ' (nháy trên) ở đầu , thì dòng hay đoạn text sau đó là ghi chú (biến thành màu xanh lá cây trong VBE)

nghĩa là khi đó chúng không có giá trị gì, có thể xóa đi mà không ảnh hưởng gì
(ở đây để lại, cho bạn biết dòng/ đoạn đó nên vứt đi hay đã thay thế bằng cái khác)

Muốn tìm hiểu VBA nên học cơ bản từ đầu, chứ rẽ ngang không những không hiểu, mà có thể tẩu hỏa... nếu cố hiểu

Nếu cột 1 =stt thì lùi 3 dòng thành bảng phân bổ sẽ được ngắt

đoạn này bạn hiểu đúng, vì căn cứ vào "STT" cho nó dễ (không lẫn chữ việt có dấu) và điển hình ở từng bảng

 

[bongmaihung]

Có dấu ' (nháy trên) ở đầu , thì dòng hay đoạn text sau đó là ghi chú (biến thành màu xanh lá cây trong VBE)

nghĩa là khi đó chúng không có giá trị gì, có thể xóa đi mà không ảnh hưởng gì
(ở đây để lại, cho bạn biết dòng/ đoạn đó nên vứt đi hay đã thay thế bằng cái khác)

Muốn tìm hiểu VBA nên học cơ bản từ đầu, chứ rẽ ngang không những không hiểu, mà có thể tẩu hỏa... nếu cố hiểu



đoạn này bạn hiểu đúng, vì căn cứ vào "STT" cho nó dễ (không lẫn chữ việt có dấu) và điển hình ở từng bảng

Em cảm ơn anh,
có vấn đề thế này ah, file thật của em là 573 dòng, em làm trên file thật có rất nhiều sheet thì báo script out of range
Nhưng nếu em copy riêng bảng phân bổ sang một workbook mới thì lại chạy ok
Em biết sửa lỗi này rồi ah. Do tên sheet em đặt dài quá nên nó báo vậy. em sửa lại tên sheet đã ok. Em cảm ơn anh nhiều

 

[bongmaihung]

bạn sửa lại SUB thế này

Sub NgatTrang()
Dim rc As Long, stt As String ''Integer
Sheets("sheet1").Select
ActiveSheet.ResetAllPageBreaks
rc = Cells(Cells.Rows.Count, 2).End(xlUp).Row
stt = "STT"
ActiveSheet.ResetAllPageBreaks
For r = 8 To rc
  If Cells(r, 1) = stt Then
    ActiveSheet.HPageBreaks.Add Before:=Cells(r, 1).Offset(-3)
    ''stt = Cells(r, 2)
  End If
Next
End Sub

Tại sao thế, bạn tự so sánh xem khác biệt cái gì thì rút ra được câu trả lời

Tuy vậy, cách nhanh hơn là dùng phương thức FIND của RANGE (tự tìm trên diễn đàn) thì nhanh hơn (nếu tổng số dòng dữ liệu trong sheet không nhiều thì tạm dùng SUB kia cũng được)

Sub NgatTrang()
Dim Rng As Range, clls As Range, r As Long
With Sheets("sheet1")
Set Rng = .Range(.[A1], .[A65000].End(xlUp).Row)
End With
ActiveSheet.ResetAllPageBreaks
stt = Rng.Find("STT", After:=LastCell, LookIn:=xlValues, LookAt:=xlWhole)
r=7
For Each clls In Rng
    r = r + 1
  If clls(r, 1) = stt Then
    ActiveSheet.HPageBreaks.Add Before:=clls(r, 1).Offset(-3)
    ''stt = Cells(r, 2)
  End If
Next
End Sub

Em thử bằng Find Method chưa được, nhờ anh chị giúp đỡ ah

 

[Zerothink]

Sub NgatTrang()
Dim Rng As Range, clls As Range, r As Long
With Sheets("sheet1")
Set Rng = .Range(.[A1], .[A65000].End(xlUp).Row)
End With
ActiveSheet.ResetAllPageBreaks
stt = Rng.Find("STT", After:=LastCell, LookIn:=xlValues, LookAt:=xlWhole)
r=7
For Each clls In Rng
    r = r + 1
  If clls(r, 1) = stt Then
    ActiveSheet.HPageBreaks.Add Before:=clls(r, 1).Offset(-3)
    ''stt = Cells(r, 2)
  End If
Next
End Sub

Em thử bằng Find Method chưa được, nhờ anh chị giúp đỡ ah

FIND thì thế này:

Sub NgatTrang()
    Const stT = "STT"
    Dim Rc As Long, c As Range, firstAddress As String
    With Sheets("sheet1")
        Rc = .Cells(.Cells.Rows.Count, 2).End(xlUp).Row
        .ResetAllPageBreaks
        
        With .Range("A6:A" & Rc)
            Set c = .Find(stT, LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    ActiveSheet.HPageBreaks.Add Before:=c.Offset(-3)
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    End With
End Sub

 

[bongmaihung]

FIND thì thế này:

Sub NgatTrang()
    Const stT = "STT"
    Dim Rc As Long, c As Range, firstAddress As String
    With Sheets("sheet1")
        Rc = .Cells(.Cells.Rows.Count, 2).End(xlUp).Row
        .ResetAllPageBreaks
        
        With .Range("A6:A" & Rc)
            Set c = .Find(stT, LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    ActiveSheet.HPageBreaks.Add Before:=c.Offset(-3)
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    End With
End Sub

Em test đã thành công, cảm ơn anh nhé
Bác chắc cũng dân lập trình. Viết code hay quá

 

[Zerothink]

Em test đã thành công, cảm ơn anh nhé
Bác chắc cũng dân lập trình. Viết code hay quá

Tay ngang thui, đang tầm sư học đạo mà không ai nhận đây, nên phải tự tìm hiểu và viết đại

cứ kiểm tra kỹ đó, và ứng dụng được là mừng rui

nên đổi dòng này

.ActiveSheet.HPageBreaks.Add Before:=c.Offset(-3)

thành

.Parent.HPageBreaks.Add Before:=c.Offset(-3)

cho chính xác hơn

 

[bongmaihung]

Tay ngang thui, đang tầm sư học đạo mà không ai nhận đây, nên phải tự tìm hiểu và viết đại

cứ kiểm tra kỹ đó, và ứng dụng được là mừng rui

Tay ngang nhưng cũng ứng dụng tốt hơn em nhiều roài
Em gửi đường link về Find của GPE, bạn nào quan tâm thì xem thử
http://www.giaiphapexcel.com/forum/showthread.php?15116-T%E1%BB%95ng-h%E1%BB%A3p-v%E1%BB%81-ph%C6%B0%C6%A1ng-th%E1%BB%A9c-t%C3%ACm-ki%E1%BA%BFm-FIND-%28Find-Method%29
Mà topic này hay quá nhưng em chưa có thòi gian đọc

 

[bongmaihung]

Tay ngang thui, đang tầm sư học đạo mà không ai nhận đây, nên phải tự tìm hiểu và viết đại

cứ kiểm tra kỹ đó, và ứng dụng được là mừng rui

nên đổi dòng này

.ActiveSheet.HPageBreaks.Add Before:=c.Offset(-3)

thành


cho chính xác hơn

Em đã sửa lại tía má, thấy có vẻ hợp lý hơn. Em test cũng đã ok

 

[bongmaihung]

Em đã tìm được nguyên nhân sai

 

[bongmaihung]

Bài #11 đã giải quyết được yêu cầu của em nhưng nếu dữ liệu dài em thấy code chạy hơi lâu, em tìm cách đưa vào mảng vòng lặp nhưng chưa được.
Nhờ anh chị tối ưu code để có thể chạy nhanh hơn

 

[bongmaihung]

Em đã tìm được cách đưa vào vòng lặp. Tốc độ tương đối ok

 

[bongmaihung]

[COLOR=#0000BB][FONT=monospace][I]Sub NgatTrang[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]()
    Const [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]stT [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"STT"
    [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Dim Rc [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Long[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]c [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]firstAddress [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]String
    With Sheets[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"sheet1"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
        [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Rc [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= .[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Cells[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](.[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Cells[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Rows[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Count[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]2[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]End[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]xlUp[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Row
        [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]ResetAllPageBreaks
        
        With [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"A6:A" [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]& [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Rc[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
            [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Set c [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= .[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Find[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]stT[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]LookIn[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]:=[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]xlValues[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]LookAt[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]:=[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]xlWhole[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
            If [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Not c Is Nothing Then
                firstAddress [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]c[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Address
                [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]Do
                    [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]ActiveSheet[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]HPageBreaks[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Add Before[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]:=[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]c[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Offset[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](-[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
                    [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Set c [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= .[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]FindNext[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]c[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
                [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Loop [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]While [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]c[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Address [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]<> [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]firstAddress
            End [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]If
        [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]End With
    End With
End Sub  [/I][/FONT][/COLOR]

Với phương thức Find Method như code này nếu dữ liệu nhiều thì hơi chậm, nhờ anh chị giúp cải tiến tốc độ với phương thức này, còn cách đưa vào vòng lặp em thử chỉ mất khoảng 0.2s