Nhờ viết code in tự động có điều kiện

[Vunguyen87]

Xin chào tất cả các thành viên của diễn đàn!
Mình có một công việc cần phải in dữ liệu của từng người, mỗi người một trang theo một mẫu chung. Bình thường mình sẽ chấm công hết cả tháng, sau đó mình bấm lọc từng bộ phận, từng người rồi bấm in. (Trong file dưới mình chỉ lấy mẫu một phần thông tin của cả tháng).
Mình muốn nhờ các anh, chị, các bạn viết giúp mình code để mình có thể chọn từng bộ phận và in toàn bộ danh sách công nhân trong bộ phận đó theo form mẫu ạ.
Rất mong nhận được sự giúp đỡ ạ. Dữ liệu mình thể hiện trong tập tin đính kèm ạ.
Mình cảm ơn !

 

[snow25]

Xin chào tất cả các thành viên của diễn đàn!
Mình có một công việc cần phải in dữ liệu của từng người, mỗi người một trang theo một mẫu chung. Bình thường mình sẽ chấm công hết cả tháng, sau đó mình bấm lọc từng bộ phận, từng người rồi bấm in. (Trong file dưới mình chỉ lấy mẫu một phần thông tin của cả tháng).
Mình muốn nhờ các anh, chị, các bạn viết giúp mình code để mình có thể chọn từng bộ phận và in toàn bộ danh sách công nhân trong bộ phận đó theo form mẫu ạ.
Rất mong nhận được sự giúp đỡ ạ. Dữ liệu mình thể hiện trong tập tin đính kèm ạ.
Mình cảm ơn !

Bạn thử code

Sub inbang()
   Dim i As Long, lr As Long, dic As Object, arr, kq, data, dk As String, T, k As Long, a As Long, j As Long
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("File Dl")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A4:T" & lr).Value
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If Not dic.exists(dk) Then
               dic.Add dk, i
            Else
               dic.Item(dk) = dic.Item(dk) & "#" & i
            End If
        Next i
   End With
    data = dic.keys
   With Sheets("form in")
        For k = 0 To UBound(data)
            a = 0
            ReDim kq(1 To UBound(arr), 1 To UBound(arr, 2))
            For Each T In Split(dic.Item(data(k)), "#")
                a = a + 1
                For j = 1 To UBound(arr, 2)
                    kq(a, j) = arr(T, j)
                Next j
            Next
            .Range("A4:T34").Value = kq
            '.PrintPreview
            .PrintOut
        Next k
   End With
   Set dic = Nothing
End Sub

 

[Vunguyen87]

Bạn thử code

Sub inbang()
   Dim i As Long, lr As Long, dic As Object, arr, kq, data, dk As String, T, k As Long, a As Long, j As Long
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("File Dl")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A4:T" & lr).Value
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If Not dic.exists(dk) Then
               dic.Add dk, i
            Else
               dic.Item(dk) = dic.Item(dk) & "#" & i
            End If
        Next i
   End With
    data = dic.keys
   With Sheets("form in")
        For k = 0 To UBound(data)
            a = 0
            ReDim kq(1 To UBound(arr), 1 To UBound(arr, 2))
            For Each T In Split(dic.Item(data(k)), "#")
                a = a + 1
                For j = 1 To UBound(arr, 2)
                    kq(a, j) = arr(T, j)
                Next j
            Next
            .Range("A4:T34").Value = kq
            '.PrintPreview
            .PrintOut
        Next k
   End With
   Set dic = Nothing
End Sub

Cảm ơn bạn đã giúp đỡ, mai mình sẽ chạy thử ạ.

 

[Vunguyen87]

Bạn thử code

Sub inbang()
   Dim i As Long, lr As Long, dic As Object, arr, kq, data, dk As String, T, k As Long, a As Long, j As Long
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("File Dl")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A4:T" & lr).Value
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If Not dic.exists(dk) Then
               dic.Add dk, i
            Else
               dic.Item(dk) = dic.Item(dk) & "#" & i
            End If
        Next i
   End With
    data = dic.keys
   With Sheets("form in")
        For k = 0 To UBound(data)
            a = 0
            ReDim kq(1 To UBound(arr), 1 To UBound(arr, 2))
            For Each T In Split(dic.Item(data(k)), "#")
                a = a + 1
                For j = 1 To UBound(arr, 2)
                    kq(a, j) = arr(T, j)
                Next j
            Next
            .Range("A4:T34").Value = kq
            '.PrintPreview
            .PrintOut
        Next k
   End With
   Set dic = Nothing
End Sub

Mình đã chạy thử rồi bạn ạ. Kết quả như mình mong muốn, bạn có thể giúp mình thêm bước chọn từng bộ phận sau đó chọn xem trước khi in được không bạn ? Với lại khi mình in ra thì định dạng của file in chưa giống với file mẫu bạn ạ. Bạn giúp mình với nhé. Cảm ơn bạn nhiều !