[Help] Dùng VBA để lọc dữ liệu và đưa ra thành từng PDF riêng

[thangheo511]

Em chào mọi người , em là thành viên mới muốn nhờ mọi người giúp đỡ vấn đề sau:
Em có một File Data quản lý khối lượng công việc của CTV (mỗi CTV em có gắn thành một mã riêng).
Cuối mỗi tháng em cần lọc theo từng mã khối lượng công việc đã làm ra một file PDF mới. Trước đây số lượng ít thì em dùng thủ công, nhưng giờ số lượng tăng lên nên muốn hỏi mọi người cách dùng VBA để lọc tự động cho nhanh.
Mong được GPE giúp đỡ, em cảm ơn nhiều !
Em có đính kèm thêm file DATA (cái này chỉ mới có mấy ngày đầu tháng), số row có tháng gần 1000 row.

 

[snow25]

Em chào mọi người , em là thành viên mới muốn nhờ mọi người giúp đỡ vấn đề sau:
Em có một File Data quản lý khối lượng công việc của CTV (mỗi CTV em có gắn thành một mã riêng).
Cuối mỗi tháng em cần lọc theo từng mã khối lượng công việc đã làm ra một file PDF mới. Trước đây số lượng ít thì em dùng thủ công, nhưng giờ số lượng tăng lên nên muốn hỏi mọi người cách dùng VBA để lọc tự động cho nhanh.
Mong được GPE giúp đỡ, em cảm ơn nhiều !
Em có đính kèm thêm file DATA (cái này chỉ mới có mấy ngày đầu tháng), số row có tháng gần 1000 row.

Bạn cho cái ví dụ khi in ra PDF nào.

 

[thangheo511]

Bạn cho cái ví dụ khi in ra PDF nào.

PDF ở đây ý là mình lưu excel dưới dạng PDF, hoặc đơn giản là tách từng mã ctv thành từng file excel riêng lẻ cũng được a

 

[snow25]

PDF ở đây ý là mình lưu excel dưới dạng PDF, hoặc đơn giản là tách từng mã ctv thành từng file excel riêng lẻ cũng được a

Ý mình là bạn cho cái file tách được lên đây để mình làm theo mẫu đó ấy.Chứ biết tách theo kiểu gì.

 

[thangheo511]

Ý mình là bạn cho cái file tách được lên đây để mình làm theo mẫu đó ấy.Chứ biết tách theo kiểu gì.

Mình gửi bạn 2 mẫu tách của 2 nhóm CTV và CKR, bạn ưu tiên xem CTV trước nha. Vì CKR nếu khó quá mình dùng tay cũng được

 

[snow25]

Mình gửi bạn 2 mẫu tách của 2 nhóm CTV và CKR, bạn ưu tiên xem CTV trước nha. Vì CKR nếu khó quá mình dùng tay cũng được

Bạn thử code này nhé.Nếu đã có file đó rồi tự động nó ghi đè file mới lên nhé.

Sub tachfile()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim arr, i As Long, j As Long, lr As Long, kq, dic As Object, dk As String, s As String, T, ten, a As Long, wb As Workbook
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("CV")
         lr = .Range("D" & Rows.Count).End(xlUp).Row
         arr = .Range("A1:J" & lr).Value
         For i = 2 To UBound(arr)
             dk = UCase(arr(i, 4))
             If Not dic.exists(dk) Then
                dic.Add dk, "#" & i
             Else
                s = dic.Item(dk)
                s = s & "#" & i
                dic.Item(dk) = s
             End If
        Next i
    End With
        For Each ten In dic.keys
            ReDim kq(1 To UBound(arr), 1 To 7)
            For i = 1 To 7
                kq(1, i) = arr(1, i)
            Next i
            s = dic.Item(ten)
            T = Split(s, "#")
            For i = 1 To UBound(T)
                a = T(i)
                For j = 1 To 7
                    kq(i + 1, j) = arr(a, j)
                Next j
            Next i
            Set wb = Workbooks.Add
            wb.Sheets(1).Range("A1:g1").Resize(i).Value = kq
            wb.SaveAs ThisWorkbook.Path & "\" & ten & ".xlsx"
            wb.Close
       Next
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

 

[thangheo511]

Bạn thử code này nhé.Nếu đã có file đó rồi tự động nó ghi đè file mới lên nhé.

Mình chạy thành công rồi bạn, cảm ơn bạn nhiều nha. Để mình nghiên cứu thêm phần cho CKR , nó cũng tương tự hay sao bạn nhỉ ?