Help! Nhờ tự động xóa hàm khi chạy File in

Liên hệ QC
thanhtung0112

thanhtung0112

Thành viên chính thức
Tham gia
24/1/17
Bài viết
51
Được thích
5
Hiện tại mình có 1 File in tự động, nhưng vì mỗi STT là số lượng công nhân khác nhau, mà khi mịnh in chạy File thì hàm nó không bỏ đi được, cho nên sẽ in bị dư giấy. Nhớ mấy huynh giúp em xóa hàm dư với, Em xin cảm ơn.
File hình nè mấy huynh.
1572597847455.png
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
thanhtung0112 đã viết:
Hiện tại mình có 1 File in tự động, nhưng vì mỗi STT là số lượng công nhân khác nhau, mà khi mịnh in chạy File thì hàm nó không bỏ đi được, cho nên sẽ in bị dư giấy. Nhớ mấy huynh giúp em xóa hàm dư với, Em xin cảm ơn.
File hình nè mấy huynh.
View attachment 227562
Nhấp chuột vào đây để mở rộng...
Nếu xóa công thức đi thì cái sau làm sao mà nhận được giá trị để in chứ.Chỉ viết code khác là nhanh thôi.
 
Upvote 0
thanhtung0112 đã viết:
bởi, khả năng mình tới đó hoy, nên nhờ mấy huynh giúp đỡ nè, hiz
Nhấp chuột vào đây để mở rộng...
Bạn thử xem đúng không nhé.Bỏ hết công thức cả 2 sheets không cần dùng.
Mã: 
Sub innhanh()
Application.ScreenUpdating = False
    Dim a As Long, b As Long, i As Long, dic As Object, arr, lr As Long, s As String, dk As String, kq, data, T, k As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         arr = .Range("D2:J" & lr).Value
         For i = 1 To UBound(arr)
             dk = UCase(arr(i, 6))
             If Not dic.exists(dk) Then
                dic.Add dk, "#" & i
             Else
                dic.Item(dk) = dic.Item(dk) & "#" & i
             End If
         Next i
    End With
    With Sheets("DS")
         a = .Range("s5").Value - 1
         b = .Range("s6").Value - 1
    End With
    If a > b Then MsgBox "nhap so sai": Exit Sub
    If b > dic.Count Then MsgBox "qua lon": Exit Sub
    data = dic.keys
    With Sheets("DS")
         For i = a To b
             a = 0
             s = dic.Item(data(i))
             T = Split(s, "#")
             ReDim kq(1 To UBound(T), 1 To 4)
             For k = 1 To UBound(T)
                 a = a + 1
                 kq(a, 1) = a
                 kq(a, 2) = arr(T(k), 2)
                 kq(a, 3) = arr(T(k), 3)
                 kq(a, 4) = arr(T(k), 4)
             Next k
             .Range("A15:D999").ClearContents
             .Rows("15:999").EntireRow.Hidden = False
             If a Then
                .Range("A15:D15").Resize(a).Value = kq
                .Rows(a + 16 & ":998").EntireRow.Hidden = True
             End If
             .PrintOut
             '.PrintPreview
         Next i
   End With
Application.ScreenUpdating = True
End Sub
 

File đính kèm

Upvote 0
snow25 đã viết:
Bạn thử xem đúng không nhé.Bỏ hết công thức cả 2 sheets không cần dùng.
Mã: 
Sub innhanh()
Application.ScreenUpdating = False
    Dim a As Long, b As Long, i As Long, dic As Object, arr, lr As Long, s As String, dk As String, kq, data, T, k As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         arr = .Range("D2:J" & lr).Value
         For i = 1 To UBound(arr)
             dk = UCase(arr(i, 6))
             If Not dic.exists(dk) Then
                dic.Add dk, "#" & i
             Else
                dic.Item(dk) = dic.Item(dk) & "#" & i
             End If
         Next i
    End With
    With Sheets("DS")
         a = .Range("s5").Value - 1
         b = .Range("s6").Value - 1
    End With
    If a > b Then MsgBox "nhap so sai": Exit Sub
    If b > dic.Count Then MsgBox "qua lon": Exit Sub
    data = dic.keys
    With Sheets("DS")
         For i = a To b
             a = 0
             s = dic.Item(data(i))
             T = Split(s, "#")
             ReDim kq(1 To UBound(T), 1 To 4)
             For k = 1 To UBound(T)
                 a = a + 1
                 kq(a, 1) = a
                 kq(a, 2) = arr(T(k), 2)
                 kq(a, 3) = arr(T(k), 3)
                 kq(a, 4) = arr(T(k), 4)
             Next k
             .Range("A15:D999").ClearContents
             .Rows("15:999").EntireRow.Hidden = False
             If a Then
                .Range("A15:D15").Resize(a).Value = kq
                .Rows(a + 16 & ":998").EntireRow.Hidden = True
             End If
             .PrintOut
             '.PrintPreview
         Next i
   End With
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
1572667218960.png
bộ phận s nó ra ngày tháng năm sinh r nè bạn ơi
 
Upvote 0
thanhtung0112 đã viết:
View attachment 227615
bộ phận s nó ra ngày tháng năm sinh r nè bạn ơi
Nhấp chuột vào đây để mở rộng...
Buồn ngủ chắc nhìn nhầm.Bạn thử code này.
Mã: 
Sub innhanh()
Application.ScreenUpdating = False
    Dim a As Long, b As Long, i As Long, dic As Object, arr, lr As Long, s As String, dk As String, kq, data, T, k As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         arr = .Range("D2:J" & lr).Value
         For i = 1 To UBound(arr)
             dk = UCase(arr(i, 6))
             If Not dic.exists(dk) Then
                dic.Add dk, "#" & i
             Else
                dic.Item(dk) = dic.Item(dk) & "#" & i
             End If
         Next i
    End With
    With Sheets("DS")
         a = .Range("s5").Value - 1
         b = .Range("s6").Value - 1
    End With
    If a > b Then MsgBox "nhap so sai": Exit Sub
    If b > dic.Count Then MsgBox "qua lon": Exit Sub
    data = dic.keys
    With Sheets("DS")
         For i = a To b
             a = 0
             s = dic.Item(data(i))
             T = Split(s, "#")
             ReDim kq(1 To UBound(T), 1 To 4)
             For k = 1 To UBound(T)
                 a = a + 1
                 kq(a, 1) = a
                 kq(a, 2) = arr(T(k), 2)
                 kq(a, 3) = arr(T(k), 3)
                 kq(a, 4) = arr(T(k), 6)
             Next k
             .Range("A15:D999").ClearContents
             .Rows("15:999").EntireRow.Hidden = False
             If a Then
                .Range("A15:D15").Resize(a).Value = kq
                .Rows(a + 16 & ":998").EntireRow.Hidden = True
             End If
             .PrintOut
             '.PrintPreview
         Next i
   End With
Application.ScreenUpdating = True
End Sub
Bài đã được tự động gộp:

snow25 đã viết:
Buồn ngủ chắc nhìn nhầm.Bạn thử code này.
Mã: 
Sub innhanh()
Application.ScreenUpdating = False
    Dim a As Long, b As Long, i As Long, dic As Object, arr, lr As Long, s As String, dk As String, kq, data, T, k As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         arr = .Range("D2:J" & lr).Value
         For i = 1 To UBound(arr)
             dk = UCase(arr(i, 6))
             If Not dic.exists(dk) Then
                dic.Add dk, "#" & i
             Else
                dic.Item(dk) = dic.Item(dk) & "#" & i
             End If
         Next i
    End With
    With Sheets("DS")
         a = .Range("s5").Value - 1
         b = .Range("s6").Value - 1
    End With
    If a > b Then MsgBox "nhap so sai": Exit Sub
    If b > dic.Count Then MsgBox "qua lon": Exit Sub
    data = dic.keys
    With Sheets("DS")
         For i = a To b
             a = 0
             s = dic.Item(data(i))
             T = Split(s, "#")
             ReDim kq(1 To UBound(T), 1 To 4)
             For k = 1 To UBound(T)
                 a = a + 1
                 kq(a, 1) = a
                 kq(a, 2) = arr(T(k), 2)
                 kq(a, 3) = arr(T(k), 3)
                 kq(a, 4) = arr(T(k), 6)
             Next k
             .Range("A15:D999").ClearContents
             .Rows("15:999").EntireRow.Hidden = False
             If a Then
                .Range("A15:D15").Resize(a).Value = kq
                .Rows(a + 16 & ":998").EntireRow.Hidden = True
             End If
             .PrintOut
             '.PrintPreview
         Next i
   End With
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn sửa theo code này nhé.
Mã: 
Sub innhanh()
Application.ScreenUpdating = False
    Dim a As Long, b As Long, i As Long, dic As Object, arr, lr As Long, s As String, dk As String, kq, data, T, k As Long, c As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         arr = .Range("D2:J" & lr).Value
         For i = 1 To UBound(arr)
             dk = UCase(arr(i, 6))
             If Not dic.exists(dk) Then
                dic.Add dk, "#" & i
             Else
                dic.Item(dk) = dic.Item(dk) & "#" & i
             End If
         Next i
    End With
    With Sheets("DS")
         a = .Range("s5").Value - 1
         b = .Range("s6").Value - 1
    End With
    If a > b Then MsgBox "nhap so sai": Exit Sub
    If b > dic.Count Then MsgBox "qua lon": Exit Sub
    data = dic.keys
    With Sheets("DS")
         For i = a To b
             c = 0
             s = dic.Item(data(i))
             T = Split(s, "#")
             ReDim kq(1 To UBound(T), 1 To 4)
             For k = 1 To UBound(T)
                 c = c + 1
                 kq(c, 1) = c
                 kq(c, 2) = arr(T(k), 2)
                 kq(c, 3) = arr(T(k), 3)
                 kq(c, 4) = arr(T(k), 6)
             Next k
             .Range("A15:D999").ClearContents
             .Rows("15:999").EntireRow.Hidden = False
             If c Then
                .Range("A15:D15").Resize(c).Value = kq
                .Rows(c + 16 & ":998").EntireRow.Hidden = True
             End If
             .PrintOut
             '.PrintPreview
         Next i
   End With
Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
snow25 đã viết:
Buồn ngủ chắc nhìn nhầm.Bạn thử code này.
Mã: 
Sub innhanh()
Application.ScreenUpdating = False
    Dim a As Long, b As Long, i As Long, dic As Object, arr, lr As Long, s As String, dk As String, kq, data, T, k As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         arr = .Range("D2:J" & lr).Value
         For i = 1 To UBound(arr)
             dk = UCase(arr(i, 6))
             If Not dic.exists(dk) Then
                dic.Add dk, "#" & i
             Else
                dic.Item(dk) = dic.Item(dk) & "#" & i
             End If
         Next i
    End With
    With Sheets("DS")
         a = .Range("s5").Value - 1
         b = .Range("s6").Value - 1
    End With
    If a > b Then MsgBox "nhap so sai": Exit Sub
    If b > dic.Count Then MsgBox "qua lon": Exit Sub
    data = dic.keys
    With Sheets("DS")
         For i = a To b
             a = 0
             s = dic.Item(data(i))
             T = Split(s, "#")
             ReDim kq(1 To UBound(T), 1 To 4)
             For k = 1 To UBound(T)
                 a = a + 1
                 kq(a, 1) = a
                 kq(a, 2) = arr(T(k), 2)
                 kq(a, 3) = arr(T(k), 3)
                 kq(a, 4) = arr(T(k), 6)
             Next k
             .Range("A15:D999").ClearContents
             .Rows("15:999").EntireRow.Hidden = False
             If a Then
                .Range("A15:D15").Resize(a).Value = kq
                .Rows(a + 16 & ":998").EntireRow.Hidden = True
             End If
             .PrintOut
             '.PrintPreview
         Next i
   End With
Application.ScreenUpdating = True
End Sub
Bài đã được tự động gộp:


Bạn sửa theo code này nhé.
Mã: 
Sub innhanh()
Application.ScreenUpdating = False
    Dim a As Long, b As Long, i As Long, dic As Object, arr, lr As Long, s As String, dk As String, kq, data, T, k As Long, c As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         arr = .Range("D2:J" & lr).Value
         For i = 1 To UBound(arr)
             dk = UCase(arr(i, 6))
             If Not dic.exists(dk) Then
                dic.Add dk, "#" & i
             Else
                dic.Item(dk) = dic.Item(dk) & "#" & i
             End If
         Next i
    End With
    With Sheets("DS")
         a = .Range("s5").Value - 1
         b = .Range("s6").Value - 1
    End With
    If a > b Then MsgBox "nhap so sai": Exit Sub
    If b > dic.Count Then MsgBox "qua lon": Exit Sub
    data = dic.keys
    With Sheets("DS")
         For i = a To b
             c = 0
             s = dic.Item(data(i))
             T = Split(s, "#")
             ReDim kq(1 To UBound(T), 1 To 4)
             For k = 1 To UBound(T)
                 c = c + 1
                 kq(c, 1) = c
                 kq(c, 2) = arr(T(k), 2)
                 kq(c, 3) = arr(T(k), 3)
                 kq(c, 4) = arr(T(k), 6)
             Next k
             .Range("A15:D999").ClearContents
             .Rows("15:999").EntireRow.Hidden = False
             If c Then
                .Range("A15:D15").Resize(c).Value = kq
                .Rows(c + 16 & ":998").EntireRow.Hidden = True
             End If
             .PrintOut
             '.PrintPreview
         Next i
   End With
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Được rồi bạn ơi, cảm ơn bạn nhiều lắm, mà nó bị dư 2 hàng, có xóa được không bạn
1572669638108.png
 
Upvote 0
thanhtung0112 đã viết:
Được rồi bạn ơi, cảm ơn bạn nhiều lắm, mà nó bị dư 2 hàng, có xóa được không bạn
View attachment 227618
Nhấp chuột vào đây để mở rộng...
Bạn thử.
Mã: 
Sub innhanh()
Application.ScreenUpdating = False
    Dim a As Long, b As Long, i As Long, dic As Object, arr, lr As Long, s As String, dk As String, kq, data, T, k As Long, c As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         arr = .Range("D2:J" & lr).Value
         For i = 1 To UBound(arr)
             dk = UCase(arr(i, 6))
             If Not dic.exists(dk) Then
                dic.Add dk, "#" & i
             Else
                dic.Item(dk) = dic.Item(dk) & "#" & i
             End If
         Next i
    End With
    With Sheets("DS")
         a = .Range("s5").Value - 1
         b = .Range("s6").Value - 1
    End With
    If a > b Then MsgBox "nhap so sai": Exit Sub
    If b > dic.Count Then MsgBox "qua lon": Exit Sub
    data = dic.keys
    With Sheets("DS")
         For i = a To b
             c = 0
             s = dic.Item(data(i))
             T = Split(s, "#")
             ReDim kq(1 To UBound(T), 1 To 4)
             For k = 1 To UBound(T)
                 c = c + 1
                 kq(c, 1) = c
                 kq(c, 2) = arr(T(k), 2)
                 kq(c, 3) = arr(T(k), 3)
                 kq(c, 4) = arr(T(k), 6)
             Next k
             .Range("A15:D999").ClearContents
             .Rows("15:999").EntireRow.Hidden = False
             If c Then
                .Range("A15:D15").Resize(c).Value = kq
                .Rows(c + 15 & ":999").EntireRow.Hidden = True
             End If
             .PrintOut
             '.PrintPreview
         Next i
   End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
snow25 đã viết:
Bạn thử.
Mã: 
Sub innhanh()
Application.ScreenUpdating = False
    Dim a As Long, b As Long, i As Long, dic As Object, arr, lr As Long, s As String, dk As String, kq, data, T, k As Long, c As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         arr = .Range("D2:J" & lr).Value
         For i = 1 To UBound(arr)
             dk = UCase(arr(i, 6))
             If Not dic.exists(dk) Then
                dic.Add dk, "#" & i
             Else
                dic.Item(dk) = dic.Item(dk) & "#" & i
             End If
         Next i
    End With
    With Sheets("DS")
         a = .Range("s5").Value - 1
         b = .Range("s6").Value - 1
    End With
    If a > b Then MsgBox "nhap so sai": Exit Sub
    If b > dic.Count Then MsgBox "qua lon": Exit Sub
    data = dic.keys
    With Sheets("DS")
         For i = a To b
             c = 0
             s = dic.Item(data(i))
             T = Split(s, "#")
             ReDim kq(1 To UBound(T), 1 To 4)
             For k = 1 To UBound(T)
                 c = c + 1
                 kq(c, 1) = c
                 kq(c, 2) = arr(T(k), 2)
                 kq(c, 3) = arr(T(k), 3)
                 kq(c, 4) = arr(T(k), 6)
             Next k
             .Range("A15:D999").ClearContents
             .Rows("15:999").EntireRow.Hidden = False
             If c Then
                .Range("A15:D15").Resize(c).Value = kq
                .Rows(c + 15 & ":999").EntireRow.Hidden = True
             End If
             .PrintOut
             '.PrintPreview
         Next i
   End With
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
cảm ơn bạn nhiều lắm, mình đỡ cực nhiều lắm luôn, cảm ơn bạn
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Thanh271188
Tìm giá trị xuất hiện bất kì (không phải giá trị đầu, cuối) trong excel
    • Cười
Trả lời
4
Đọc
169
Duy Tùng 9x
Duy Tùng 9x
H
Xin viết dùng mã vba thay thế cho hàm vlookup
    • Thích
12 13 14
Trả lời
264
Đọc
79K
VetMini
V
SA_DQ
  • Question Question
[Bài tập VBA cho người rỗi rảnh] Hãy viết 1 macro tìm ra 3 số nguyên tố liên tiếp
2
Trả lời
35
Đọc
703
VetMini
V
Nauduong
Cách chuyển định dạng từ PDF sang Image
Trả lời
4
Đọc
114
Châu Bá Thông
Châu Bá Thông
minhduongct
  • Question Question
Viết code VBA thay cho dùng hàm vlookup
Trả lời
5
Đọc
1K
Hoàng Tuấn 868
H
P
Các Bác cho e hỏi làm thế nào để ẩn công thức trên GOOGLE SHEET với ạ?
2
Trả lời
22
Đọc
18K
yeudoi
yeudoi
T
Định dạng cột dữ liệu trong sql
Trả lời
5
Đọc
115
ptm0412
ptm0412
L
  • Question Question
[Hlep] Xóa ảnh theo tên và kích thước
Trả lời
8
Đọc
180
Luong24
L
Xoainon3005
Xin file mẫu kế hoạch sản xuất theo tháng ngành động cơ
Trả lời
0
Đọc
82
Xoainon3005
Xoainon3005
A
Tạo vé Loto bằng Excel
Trả lời
19
Đọc
23K
vinhquang14292
vinhquang14292
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
308
Đọc
22K
CheezeTube
CheezeTube
HeSanbi
  • Đã giải quyết
LocalizeXL v1.73 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3 4
Trả lời
74
Đọc
10K
vn72259
V
H
Vì sao trong khi cộng và khi sum lại hiển thị sai
Trả lời
15
Đọc
57K
hieung99
hieung99
T
Nhờ hỗ trợ hàm SUMIF không phân biệt được các ký tự "0" trước một số trong chuỗi
Trả lời
3
Đọc
207
tan10ckn
T
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2 3
Trả lời
46
Đọc
14K
tuantran203
T
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
12 13 14
Trả lời
260
Đọc
27K
hoangtuan.net
hoangtuan.net
HeSanbi
  • Đã giải quyết
WeatherXL - Ứng dụng lấy dữ liệu Thời tiết siêu nhanh (*15/01/2024)
    • Thích
    • Yêu thích
3 4 5
Trả lời
88
Đọc
19K
vc_đi chơi
vc_đi chơi
L
[Help] tự động lấy dữ liệu cổ phiếu từ vietstock về file excel
    • Thích
Trả lời
3
Đọc
877
ketoan113
K
N
Tách chuỗi và tìm kiếm theo dữ liệu gần đúng trong chuỗi ký tự
Trả lời
8
Đọc
214
Ngocminh19
N
Mr.hieudoanxd
  • Question Question
[Cần hướng dẫn] Về lập trình Viết Function với Settimer và Killtimer
    • Thích
Trả lời
8
Đọc
363
nguyendang95
N
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom