Lọc theo điều kiện rồi tách dữ liệu ra thành nhiều files

[Tuấn Hào]

< Xin phép ẩn các bước làm, vì có nhiều người không thích >
Nội dung cần giúp: Tách File thành 14 File .xls (1 File 1 lớp)!
Cảm ơn ạ

 

[giaiphap]

B1: Tạo vòng lặp i từ 1 đến 14

B 2: Tạo Newbook mới

B 2: Lọc cột A theo điều kiện: “<>10C”& i

B 3: Xóa hết những dữ liệu vừa lọc được

B 4: Mở dữ liệu còn lại ra

(VD: i = 1 thì đến bước này từ 10C2 đến 10C14 sẽ bị xóa, chỉ còn 10C1 trong DS)

B 5: Save File vào Desktop: với tên file: “DS_HS_LOP_10C” & i & “.xls”

B 6: Quay lại File Mau.xls tiếp tục vòng lặp

Đây là đoạn chương trình e muốn thực hiện, tron quá trình học tập và tìm hiểu VBA nên nhờ anh chị giúp và học hỏi

Thấy miếng code nào trong file đây bạn, bạn đừng mô tả cách làm của bạn. Hãy mô tả mục đích cuối cùng của bạn là làm cái gì? Với dữ liệu này khi chạy code thì bạn thu lại được cái gì? Có file mẫu sau khi xuất ra càng tốt.

 

[Tuấn Hào]

Thấy miếng code nào trong file đây bạn, bạn đừng mô tả cách làm của bạn. Hãy mô tả mục đích cuối cùng của bạn là làm cái gì? Với dữ liệu này khi chạy code thì bạn thu lại được cái gì? Có file mẫu sau khi xuất ra càng tốt.

Mình muốn từ 1 File tổng Có 14 lớp học Tách ra 14 File Excel khác: Có cấu trúc tên File Tương tự (mỗi File 1 lớp và DS các lớp còn lại sẽ bị xóa)

 

[phulien1902]

Mình muốn từ 1 File tổng Có 14 lớp học Tách ra 14 File Excel khác: Có cấu trúc tên File Tương tự (mỗi File 1 lớp và DS các lớp còn lại sẽ bị xóa)

Thử:

Sub TachFile()
    Dim Sh As Worksheet, Cll As Range
    Const Pth As String = "H:\"
    Application.ScreenUpdating = False
    Set Sh = Sheets(1)
    With Sh
    If .AutoFilterMode Then .AutoFilterMode = False
    End With
    With CreateObject("scripting.dictionary")
        For Each Cll In Sh.Range("A3", Sh.Range("A" & Rows.Count).End(3))
            If Not .exists(Cll.Value) Then
                .Add Cll.Value, Nothing
                Sh.Range("A2").AutoFilter 1, Cll.Value
                Workbooks.Add (1)
                With ActiveWorkbook
                    Sh.AutoFilter.Range.Copy .Sheets(1).Range("A1")
                    .SaveAs Cll.Value & ".xlsm", 52
                    .Close False
                End With
            End If
        Next
    End With
    Sh.AutoFilterMode = False
End Sub

 

[ndu96081631]

B1: Tạo vòng lặp i từ 1 đến 14

B 2: Tạo Newbook mới

B 2: Lọc cột A theo điều kiện: “<>10C”& i

B 3: Xóa hết những dữ liệu vừa lọc được

B 4: Mở dữ liệu còn lại ra

(VD: i = 1 thì đến bước này từ 10C2 đến 10C14 sẽ bị xóa, chỉ còn 10C1 trong DS)

B 5: Save File vào Desktop: với tên file: “DS_HS_LOP_10C” & i & “.xls”

B 6: Quay lại File Mau.xls tiếp tục vòng lặp

Đây là đoạn chương trình e muốn thực hiện, tron quá trình học tập và tìm hiểu VBA nên nhờ anh chị giúp và học hỏi

Theo hướng đi này thì ngay tại lần lập thứ 1, ở B4 đã xóa sạch hết dữ liệu rồi, còn đâu cho lần lập thứ 2
Rút kinh nghiệm: Muốn gì thì mô tả vấn đề của mình (cái mình đang có và cái mình mong muốn đạt được), đừng mô tả cách phải làm. Bởi cách làm mà ta nghĩ là đúng có khi trật lất

 

[be_09]

Mình muốn từ 1 File tổng Có 14 lớp học Tách ra 14 File Excel khác: Có cấu trúc tên File Tương tự (mỗi File 1 lớp và DS các lớp còn lại sẽ bị xóa)

1/ Đã theo dõi mà xóa nó đi thì còn cái gì nữa để theo dõi.
2/ Nếu Tách Riêng mỗi lớp 1 File và dùng nó để gửi cho từng giáo viên thì nên làm, còn tách ra để xem chơi thì làm tốn công mà chẳng có ích lợi gì.

 

[Tuấn Hào]

Theo hướng đi này thì ngay tại lần lập thứ 1, ở B4 đã xóa sạch hết dữ liệu rồi, còn đâu cho lần lập thứ 2
Rút kinh nghiệm: Muốn gì thì mô tả vấn đề của mình (cái mình đang có và cái mình mong muốn đạt được), đừng mô tả cách phải làm. Bởi cách làm mà ta nghĩ là đúng có khi trật lất

À rồi, cảm ơn bạn, tại ngay B2 đã copy sang newbook mới nên mình nghĩ chạy vẫn đc

Bài đã được tự động gộp: 22/7/18

1/ Đã theo dõi mà xóa nó đi thì còn cái gì nữa để theo dõi.
2/ Nếu Tách Riêng mỗi lớp 1 File và dùng nó để gửi cho từng giáo viên thì nên làm, còn tách ra để xem chơi thì làm tốn công mà chẳng có ích lợi gì.

Tách r mail cho từng GV nha bạn, k làm chơi chi ạ

Bài đã được tự động gộp: 22/7/18

Thử:

Sub TachFile()
    Dim Sh As Worksheet, Cll As Range
    Const Pth As String = "H:\"
    Application.ScreenUpdating = False
    Set Sh = Sheets(1)
    With Sh
    If .AutoFilterMode Then .AutoFilterMode = False
    End With
    With CreateObject("scripting.dictionary")
        For Each Cll In Sh.Range("A3", Sh.Range("A" & Rows.Count).End(3))
            If Not .exists(Cll.Value) Then
                .Add Cll.Value, Nothing
                Sh.Range("A2").AutoFilter 1, Cll.Value
                Workbooks.Add (1)
                With ActiveWorkbook
                    Sh.AutoFilter.Range.Copy .Sheets(1).Range("A1")
                    .SaveAs Cll.Value & ".xlsm", 52
                    .Close False
                End With
            End If
        Next
    End With
    Sh.AutoFilterMode = False
End Sub

Cảm ơn bạn, nhưng tách ra từng File mà định dạng k giống bạn ạ ( Cột nó hẹp k được như mong muốn. Còn mình muốn vào đường dẫn theo ý mình thì chỉnh sao ạ

 

[Tuấn Hào]

Có ai giúp k ạ

 

[giaiphap]

Có ai giúp k ạ

Giúp thì có nhưng như tôi nói ở bài trên. Theo bạn thì #4 có chổ nào không theo ý bạn, ý bạn là thế nào? Giống là chổ nào giống, chổ nào không giống? Còn đường dẫn theo ý mình là sao? khi chạy code cho hiện cửa sổ để mình chọn thư mục hay khi chạy code nó tự động vào thư mục của bạn ở phương trời nào đó.

 

[Tuấn Hào]

Giúp thì có nhưng như tôi nói ở bài trên. Theo bạn thì #4 có chổ nào không theo ý bạn, ý bạn là thế nào? Giống là chổ nào giống, chổ nào không giống? Còn đường dẫn theo ý mình là sao? khi chạy code cho hiện cửa sổ để mình chọn thư mục hay khi chạy code nó tự động vào thư mục của bạn ở phương trời nào đó.

Không biết nói gì ạ Có vẻ hơi gắt gỏng @@ Cảm ơn bạn quan tâm nhé

 

[befaint]

Tách r mail cho từng GV nha bạn, k làm chơi

Có vài ba chữ còn không chịu gõ gõ gõ cho đầy đủ!!!!!
----------
Cuối cùng là gửi email => Vậy bài này chỉ là bước trung gian mà mình nghĩ ra?
Sao không gửi luôn cái file đang làm lên + danh sách email cần gửi + Nêu yêu cầu: Tách và gửi email theo điều kiện abc gì đó.
Kết quả: Có cái nút ấn vào một cái là mọi thứ cần được gửi đi. Xong!

 

[Tuấn Hào]

Cuối cùng là gửi email => Vậy bài này chỉ là bước trung gian mà mình nghĩ ra?
Sao không gửi luôn cái file đang làm lên + danh sách email cần gửi + Nêu yêu cầu: Tách và gửi email theo điều kiện abc gì đó.
Kết quả: Có cái nút ấn vào một cái là mọi thứ cần được gửi đi. Xong!

Thật ra là mình muốn học hỏi những cái đó nữa (VBA về Filter, Copy Newbook, ...) không đơn thuần là có được 1 File như mong muốn th không ạ

 

[befaint]

th không

B C K N!!!

 

[Tuấn Hào]

B C K N!!!

Cảm ơn bạn dành thời gian chỉnh cách nhắn cho mình nha ) Quen nhắn vậy thôi bạn ạ )