SỔ PHỔ CẬP THCS

[cuonghoa176]

Các bác xem giúp em, cách in theo độ tuổi nhưng sau mỗi Bản phải cách xuống 10 dòng (để ghi bổ sung sau khi in sổ)

 

[Hoang2013]

Các bác xem giúp em, cách in theo độ tuổi nhưng sau mỗi Bản phải cách xuống 10 dòng (để ghi bổ sung sau khi in sổ)

Chưa rõ í dồ của bạn lắm!
Hiện tại trong trang 'SO PC' có 35 bản & các em lứa tuổi từ 12 đến 19;
Như vậy bạn cần lập ra 35 * 7 danh sách cách nhau chục dòng?

 

[cuonghoa176]

Sổ này lập để in ra theo từng độ tuổi, mỗi độ tuổi sẽ gồm hs của cả 36 bản, sau mỗi bản cần cách xuống 10 dòng (để ghi bổ sung hs chuyển đến) Nếu dùng Auto fiter thì các bản sẽ liền nhau. Ý là như vậy..

 

[Hoang2013]

Ở đây chí ít có 2 cách làm:
(1) Lọc theo 'Bản' sau đó dò theo dòng; nếu khác tên bản thì thêm chục dòng trống;
(2) Lọc đưa vô mảng

Cả 2 cách đều phải xài VBA & trong file là cách (2) (nhưng bớt đi 1 dòng trống!)

 

[cuonghoa176]

Như đã nói, sổ này dùng để in ra theo từng độ tuổi.
Khi chọn một độ tuổi sẽ hiển thị hs của tất cả các bản (liền nhau)
Muốn rằng khi chọn để in một độ tuổi, dưới mỗi bản khác nhau sẽ có 10_dòng trống..

 

[Hoang2013]

Thì bạn tìm đâu trong chương trình có con số 9 (chắc là duy nhất W = W + 9) sửa lại thành con 10 hay con 99 nào đó mà chả được!

 

[cuonghoa176]

Các bác xem giúp yêu cầu như sau: Chọn tuổi tại cột AC (từ 0-14 tuổi, mỗi tuổi 1 Sheet) sau đó cách 5 dòng sau mỗi bản ngay tại Sheet.

 

[cuonghoa176]

Nhờ các Bác cách đơn giản hơn: Không lọc tuổi nữa, chỉ cần cách 5 dòng sau mỗi bản ngay tại Sheet

 

[befaint]

Nhờ các Bác cách đơn giản hơn: Không lọc tuổi nữa, chỉ cần cách 5 dòng sau mỗi bản ngay tại Sheet

Sub Dan5Dong()
Const nRows As Long = 5
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim arrBAN(), lR As Long, r As Long, ws As Worksheet, firstRow As Long
Set ws = Sheet1
lR = LastRow(ws, ws.Range("G1"))
firstRow = 6
If lR <= firstRow Then Exit Sub
arrBAN = ws.Range("G7:H" & lR).Value: lR = UBound(arrBAN, 1)
For r = lR To 2 Step -1
    If arrBAN(r, 1) <> "" And arrBAN(r - 1, 1) <> "" Then
        If arrBAN(r, 1) <> arrBAN(r - 1, 1) Then
            ws.Rows(r + firstRow & ":" & r + firstRow + nRows - 1).Insert Shift:=xlDown
        End If
    End If
Next r
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

'---------------------'
Function LastRow(ws As Worksheet, cll As Range) As Long
    ShowAllRows ws
    LastRow = ws.Cells(ws.Rows.Count, cll.Column).End(xlUp).Row
End Function

'---------------------'
Sub ShowAllRows(ws As Worksheet)
    ws.AutoFilterMode = False
    ws.Cells.EntireRow.Hidden = False
End Sub