Hỏi về in hàng loạt dánh sách có mã khác nhau trong một biểu (3 người xem)

[thanhnam0119]

Em chào các anh chị!
- Em có file dữ liệu bao gồm sheet "tổng hợp" và sheet "Biểu 01_BD"
Sheet tổng hợp là nơi nhập tập trung các hộ gia đình ( bao gồm các thành viên) có mã hộ khác
Sheet "Biểu 01_BD" là in từng hộ gia đình bao gồm các thành viên trong hộ
- Mục yêu cầu: muốn in hoàng loạt cùng lúc các hộ gia đình bao gồm các thành viên cùng 1 lúc ( mỗi biểu in là 01 hộ riêng).
Mong các a chị giúp đỡ

 

[snow25]

Em chào các anh chị!
- Em có file dữ liệu bao gồm sheet "tổng hợp" và sheet "Biểu 01_BD"
Sheet tổng hợp là nơi nhập tập trung các hộ gia đình ( bao gồm các thành viên) có mã hộ khác
Sheet "Biểu 01_BD" là in từng hộ gia đình bao gồm các thành viên trong hộ
- Mục yêu cầu: muốn in hoàng loạt cùng lúc các hộ gia đình bao gồm các thành viên cùng 1 lúc ( mỗi biểu in là 01 hộ riêng).
Mong các a chị giúp đỡ

Bạn chạy code này xem thế nào nhé.Bỏ hết tên sheets là tiếng việt đi nhé.

Sub intheoho()
    Dim arr, arr1, dic As Object, lr As Long, i As Long, T, T1, a, s As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("tong hop")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 3 Then Exit Sub
         arr = .Range("B3:L" & lr).Value
    End With
    For i = 1 To UBound(arr, 1)
        If Not dic.exists(arr(i, 1)) Then
           dic.Add arr(i, 1), i
        Else
           dic.Item(arr(i, 1)) = dic.Item(arr(i, 1)) & "#" & i
        End If
    Next i
      For Each T In dic.keys
        a = 0: ReDim arr1(1 To UBound(arr, 1), 1 To 10)
        s = dic.Item(T)
        For Each T1 In Split(s, "#")
            a = a + 1
            arr1(a, 1) = a
            arr1(a, 2) = arr(T1, 3)
            arr1(a, 3) = arr(T1, 2)
            arr1(a, 4) = arr(T1, 4)
            arr1(a, 5) = arr(T1, 5)
            arr1(a, 6) = arr(T1, 8)
            arr1(a, 7) = arr(T1, 9)
            arr1(a, 8) = arr(T1, 7)
            arr1(a, 9) = arr(T1, 1)
            arr1(a, 10) = arr(T1, 11)
       Next
       With Sheets("Bieu 01_BD")
            .Range("A14:j24").ClearContents
            .Rows("14:24").EntireRow.Hidden = False
            .Range("A14").Resize(a, 10) = arr1
            .Rows(a + 14 & ":24").EntireRow.Hidden = True
            .PrintOut
       End With
   Next
End Sub

 

[thanhnam0119]

Bạn chạy code này xem thế nào nhé.Bỏ hết tên sheets là tiếng việt đi nhé.

Sub intheoho()
    Dim arr, arr1, dic As Object, lr As Long, i As Long, T, T1, a, s As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("tong hop")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 3 Then Exit Sub
         arr = .Range("B3:L" & lr).Value
    End With
    For i = 1 To UBound(arr, 1)
        If Not dic.exists(arr(i, 1)) Then
           dic.Add arr(i, 1), i
        Else
           dic.Item(arr(i, 1)) = dic.Item(arr(i, 1)) & "#" & i
        End If
    Next i
      For Each T In dic.keys
        a = 0: ReDim arr1(1 To UBound(arr, 1), 1 To 10)
        s = dic.Item(T)
        For Each T1 In Split(s, "#")
            a = a + 1
            arr1(a, 1) = a
            arr1(a, 2) = arr(T1, 3)
            arr1(a, 3) = arr(T1, 2)
            arr1(a, 4) = arr(T1, 4)
            arr1(a, 5) = arr(T1, 5)
            arr1(a, 6) = arr(T1, 8)
            arr1(a, 7) = arr(T1, 9)
            arr1(a, 8) = arr(T1, 7)
            arr1(a, 9) = arr(T1, 1)
            arr1(a, 10) = arr(T1, 11)
       Next
       With Sheets("Bieu 01_BD")
            .Range("A14:j24").ClearContents
            .Rows("14:24").EntireRow.Hidden = False
            .Range("A14").Resize(a, 10) = arr1
            .Rows(a + 14 & ":24").EntireRow.Hidden = True
            .PrintOut
       End With
   Next
End Sub

Em cảm ơn a nhiều
- A có thể giúp em in thêm ở sheet "tổng hợp" tiêu chí tên chủ hộ nếu mối quan hệ là chủ hộ và địa chỉ của hộ gia đình ,cột" loại đối tượng tăng giảm" vào cột ghi chú sheet Bieu 01_BD được không ạ.
- Khi e ấn in bị lỗi

 

[snow25]

Em cảm ơn a nhiều
- A có thể giúp em in thêm ở sheet "tổng hợp" tiêu chí tên chủ hộ nếu mối quan hệ là chủ hộ và địa chỉ của hộ gia đình ,cột" loại đối tượng tăng giảm" vào cột ghi chú sheet Bieu 01_BD được không ạ.
- Khi e ấn in bị lỗi
View attachment 213000

Lỗi này chắc do máy in.Mình không có máy in nên không biết sửa thế nào à.

 

[thanhnam0119]

Lỗi này chắc do máy in.Mình không có máy in nên không biết sửa thế nào à.

a giúp e thêm mấy tiêu chí ạ, giúp em in thêm ở sheet "tổng hợp" tiêu chí tên chủ hộ nếu mối quan hệ là chủ hộ và địa chỉ của hộ gia đình ,cột" loại đối tượng tăng giảm" vào cột ghi chú sheet Bieu 01_BD được không ạ.

 

[snow25]

a giúp e thêm mấy tiêu chí ạ, giúp em in thêm ở sheet "tổng hợp" tiêu chí tên chủ hộ nếu mối quan hệ là chủ hộ và địa chỉ của hộ gia đình ,cột" loại đối tượng tăng giảm" vào cột ghi chú sheet Bieu 01_BD được không ạ.

Code kia chạy được chưa vậy.

 

[thanhnam0119]

Code kia chạy được chưa vậy.

phải run macro mới chạy đc a à. in ngon lành nhưng thiếu preview nên ko thấy nội dung in đc a à.

 

[huonglien1901]

phải run macro mới chạy đc a à. in ngon lành nhưng thiếu preview nên ko thấy nội dung in đc a à.

bạn thử cái add- i của Anh @befaint thử.

 

[snow25]

phải run macro mới chạy đc a à. in ngon lành nhưng thiếu preview nên ko thấy nội dung in đc a à.

Cái này thì bạn cài đặt thêm 1 nút chạy macro là được mà.Còn in thì bạn setup máy in trước rồi thực hiện lệnh.Mình cũng không dành về in lắm.

 

[thanhnam0119]

Code kia chạy được chưa vậy.

A giúp e hoàn thiện in mẫu bieu_01bd có thêm tiêu chí tên chủ hộ và địa chỉ đc không anh

 

[snow25]

A giúp e hoàn thiện in mẫu bieu_01bd có thêm tiêu chí tên chủ hộ và địa chỉ đc không anh

Không hiểu câu hỏi của bạn lắm.Bạn nói rõ xem nào.Mà làm vào file có mẫu để mình còn xem nhé.

 

[thanhnam0119]

Không hiểu câu hỏi của bạn lắm.Bạn nói rõ xem nào.Mà làm vào file có mẫu để mình còn xem nhé.

A giúp e in printpreview theo hiện lên hoàng loạt trang và in từ trang đến trang theo hộ được ko ạ