Form tạo Nhán dán lên thùng carton hàng hóa

[lehoctk]

Em chào anh/chị!
Em đã mày mò và cóp nhặt code để tạo những Nhãn dán lên thùng hàng hóa (như trong Sheet Sh2) trong file đính kèm ạ, Tuy nhiên code chạy rất chậm nếu Mỗi cửa hàng có 5 kiện (mỗi kiện cần 2 Nhãn dán) x 38 Cửa hàng (số lượng cửa hàng là không cố định).
Mong anh/chị giúp đỡ em cập nhật code cho nhanh hơn ạ.
Em cảm ơn!

 

[snow25]

Em chào anh/chị!
Em đã mày mò và cóp nhặt code để tạo những Nhãn dán lên thùng hàng hóa (như trong Sheet Sh2) trong file đính kèm ạ, Tuy nhiên code chạy rất chậm nếu Mỗi cửa hàng có 5 kiện (mỗi kiện cần 2 Nhãn dán) x 38 Cửa hàng (số lượng cửa hàng là không cố định).
Mong anh/chị giúp đỡ em cập nhật code cho nhanh hơn ạ.
Em cảm ơn!

Viết code 1 mẫu in từng tờ 1 đừng viết điền toàn bộ rồi in thế kia.

 

[lehoctk]

Viết code 1 mẫu in từng tờ 1 đừng viết điền toàn bộ rồi in thế kia.

Nhưng nếu in từng tờ thì em không thể dùng máy in để in đầy hết sang tờ giấy A4 ạ, hay a/c có thể gợi ý thêm cho em được không ạ?

 

[Phuocam]

Em chào anh/chị!
Em đã mày mò và cóp nhặt code để tạo những Nhãn dán lên thùng hàng hóa (như trong Sheet Sh2) trong file đính kèm ạ, Tuy nhiên code chạy rất chậm

Code làm việc trên array nhanh hơn trên range.

Thử viết lại xem sao.

.

 

[bebo021999]

Code để trong module 2. Nhấn button "Tạo booking form" để chạy.
Sheet "Temp", bạn chỉ để 1 mẫu thôi nhé. Cân chỉnh hàng, cột, chữ cho chuẩn cho 6 hàng và 2 cột.
Mẫu này sẽ được nhân lên tại sheet "nhandan"
Mình làm cho bạn phần tạo sheet "nhandan".
Phần format trang in bạn tự làm nhé.

Option Explicit
Sub nhandan()
Dim lr&, i&, j&, k&, stt&, sodong&, rng, nhan, kien&
Application.ScreenUpdating = False
With Sheets("Bang tong hop so kien")
    lr = .Cells(Rows.Count, "C").End(xlUp).Row
    rng = .Range("C2:F" & lr).Value
    kien = WorksheetFunction.Sum(.Range("F2:F" & lr))
End With

'Tao sheet nhandan
If Evaluate("=ISREF(Nhandan!A1)") Then Sheets("Nhandan").Delete
Sheets("Temp").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
    .Name = "Nhandan"
    For i = 1 To kien * 2 ' 2= so ban copy cua 1 kien
        .Rows("1:6").Copy
        .Rows(i * 6 + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    Next
    .Rows("1:6").Delete
    Application.CutCopyMode = False
    lr = Cells(Rows.Count, "A").End(xlUp).Row + 1
    nhan = Range("A1:B" & lr).Value
    For i = 1 To UBound(rng)
        sodong = rng(i, 4) * 6 * 2 ' 6= so dong cua template
        For j = 1 To sodong
            k = k + 1
            stt = (k - 1) Mod 6 + 1
            Select Case stt
                Case 3
                    nhan(k, 1) = nhan(k, 1) & " " & rng(i, 1): nhan(k, 2) = rng(i, 4)
                Case 4
                    nhan(k, 1) = rng(i, 2)
                Case 5
                    nhan(k, 1) = nhan(k, 1) & " " & IIf(rng(i, 3) = "", Format(Date + 1, "  - mm - yyyy"), Format(rng(i, 3), "dd/mm/yyyy"))
            End Select
        Next
    Next
    Range("A1:B" & lr).Value = nhan
End With
Application.ScreenUpdating = True
End Sub