Xin Nhờ Anh Chị Viết em Code tách file

Nga2022 · 21/7/22

Xin chào anh chị em muốn nhờ anh chị giúp em viết code tách file với nội dung sau
1. Tạo 1 code Tách một chủ sử dụng bất kỳ ra từng 1 file riêng, tên file đặt tên theo cột: mã [So TT] và được lưu gọn trong 1 folder (hộp thoại đính kèm)
2. Tự động Tách các chủ sử dụng ra từng file riêng, tên file đặt tên theo cột: mã [So TT] và được lưu gọn trong 1 folder
3. Khi lưu file chỉ lấy những cột có ký tự tiêu đề riêng sau: ( Mục đích tránh sau này khi chèn cột, thêm cột mới mà import dữ liệu củ sẽ sinh ra lệch cột).
Em xin chân thành cảm ơn anh chị ạ

[So TT]

[Hoten]

[namSinh]

[soGiayTo]

[ngayCap]

[noiCap]

[diaChiChu]

[Hoten2]

[namSinh2]

[soGiayTo2]

[ngayCap2]

[noiCap2]

[diaChiChu2]

Thóc Sama · 23/7/22

Nga2022 đã viết:
Lúc đầu em không nghỉ ra

Bla,bla....
Mấy trường hợp này mệt thật sự, giống như người dãn truyện, đưa ta đi từ hết "bất ngờ này" đến "bất ngờ khác" làm cho ta cảm thấy "bất mãn" lúc nào không hay!!!
_+)(9

Nga2022 · 23/7/22

Dạ em cảm ơn anh. em có file TongHopLai có các ký tự tiêu đề cột giống các ký tự tiêu đề cột các file số 1,2,3 giờ xin anh viết cho em 1 code mở hộp thoại chọn 1 file hoặc chọn nhiều file các file số 1,2,3,4 rồi import vào file file TongHopLai với điều kiện lấy dữ liệu dựa vào ký tự tiêu đề cột và nếu file TongHopLai đã có dữ liệu thì sẽ nhập vào dòng dưới dòng có dữ liệu. em xin gửi hình ảnh minh họa
Cảm ơn anh rất nhiều

Hoàng Tuấn 868 · 23/7/22

THÓC SAMA đã viết:
Mấy trường hợp này mệt thật sự

Vì nghề nghiệp của bạn này ghi là "Cán Bộ Nhà Nước" mà.

ongke0711 · 23/7/22

Nga2022 đã viết:
...

Kinh nghiệm là sau này bạn nên đưa bài toán tổng thể cần giải quyết, sau đó đưa giải thuật mà bạn nghĩ ra. Người khác sẽ xem, góp ý giải thuật, qui trình xử lý của bạn có hợp lý, có phù hợp để code hay không rồi mới tiến hành code cho nó. Muốn đưa ra giải thuật, còn phải phân tích nhiều yếu tố chứ đâu phải phép thử, sai rồi làm lại và yêu cầu mọi người chạy theo xử lý giùm bạn.

Nga2022 · 23/7/22

Em xin cảm ơn những lời góp ý quý giá của các anh.

Thóc Sama · 23/7/22

Hoàng Tuấn 868 đã viết:
Cán Bộ Nhà Nước

Hay là cán bộ hành...............chính hả bác?
$""":::":\$

thuy2022 · 23/7/22

em làm Cán bộ nhà nước hay là hay hành chính để anh THÓC SAMA còn xin sôs
haha

batman1 · 23/7/22

Nga2022 đã viết:
Dạ em cảm ơn anh. em có file TongHopLai có các ký tự tiêu đề cột giống các ký tự tiêu đề cột các file số 1,2,3 giờ xin anh viết cho em 1 code mở hộp thoại chọn 1 file hoặc chọn nhiều file các file số 1,2,3,4 rồi import vào file file TongHopLai với điều kiện lấy dữ liệu dựa vào ký tự tiêu đề cột và nếu file TongHopLai đã có dữ liệu thì sẽ nhập vào dòng dưới dòng có dữ liệu. em xin gửi hình ảnh minh họa
Cảm ơn anh rất nhiều

Bây giờ em phải đợi vì tôi đôi khi cũng có việc.
Em giới thiệu, em là cán bộ nhà nước. Em có thể bật mí cho tôi biết em làm gì không, và nếu tôi nhờ giải quyết thì em có giúp tôi miễn phí như tôi giúp em không, hay là phải có lót tay, bôi trơn, bồi dưỡng?

Nga2022 · 23/7/22

Hì anh cứ trêu em rồi. hay là phải có lót tay, bôi trơn, bồi dưỡng giờ là chết đó anh à.
Hì cũng là cán bộ hành chính ăn cơm nhà nước như các anh thui, chắc do khi đăng ký nick e sơ suất thui

batman1 · 23/7/22

Nga2022 đã viết:
em có file TongHopLai có các ký tự tiêu đề cột giống các ký tự tiêu đề cột các file số 1,2,3 giờ xin anh viết cho em 1 code mở hộp thoại chọn 1 file hoặc chọn nhiều file các file số 1,2,3,4 rồi import vào file file TongHopLai với điều kiện lấy dữ liệu dựa vào ký tự tiêu đề cột và nếu file TongHopLai đã có dữ liệu thì sẽ nhập vào dòng dưới dòng có dữ liệu. em xin gửi hình ảnh minh họa

Có một thắc mắc. Bạn nói là không lấy dữ liệu cho 2 cột H và I (hiện tại có tiêu đề là "không lấy cột này" và "không lấy cột này 2" - cứ cho đây là tiêu đề đi), nhưng code làm sao biết được là không được phép lấy dữ liệu cho cột H và I? Vì giả sử trong tập tin 1.xlsx cột H ngẫu nhiên (do bạn hứng chí tạo lập chẳng hạn) cũng có tiêu đề "không lấy cột này" thì căn cứ vào đâu để biết là không lấy cột H vào tập tin đích? Hay là bạn chắc chắn là "sẽ không có cột nào ở tập tin con có tiêu đề GIỐNG tiêu đề (kể cả tiêu đề RỖNG) ở cột không lấy dữ liệu ở tập tin chính", hoặc tương đương: "Lấy tất cả các cột từ các tập tin mà những tiêu đề đó cũng có trong tập tin chính". Và có câu hỏi: có chắc chắn là các cột cần lấy ở tập tin con sẽ có cùng thứ tự y như trong tập tin chính? Tức trong tập tin chính cột [namSinh2] đứng trước cột [soGiayTo2] thì trong các tập tin con cũng đúng thế? Không có chuyện trong tập tin con cột [soGiayTo2] đứng trước cột [namSinh2]? Tôi hỏi thế để viết code phù hợp. Nếu các cột cần lấy trong tập tin con KHÔNG theo đúng thứ tự như trong tập tin chính thì cũng viết được code. Nếu bạn muốn thế thì cũng viết được.

Bạn hãy trả lời 2 câu hỏi trên.

batman1 · 23/7/22

THÓC SAMA đã viết:
Hay là cán bộ hành...............chính hả bác?
$""":::":\$

"cán bộ hành....... LÀ .......chính"

Thóc Sama · 23/7/22

batman1 đã viết:
"cán bộ hành....... LÀ .......chính"

Ai đời lại nói “quạch toẹt” ra như thế bác?!
:gathering:

Nga2022 · 23/7/22

Dạ anh. Thứ nhất sẽ không có cột nào ở tập tin con có tiêu đề GIỐNG tiêu đề (kể cả tiêu đề RỖNG) ở cột không lấy dữ liệu ở tập tin chính", hoặc tương đương. Anh nhé. Thứ 2 nếu các cột cần lấy trong tập tin con KHÔNG theo đúng thứ tự như trong tập tin chính thì cũng viết được code, nhận diện tiêu đề để đưa vào thì quá tốt anh à.

batman1 · 23/7/22

Nga2022 đã viết:
Dạ anh. Thứ nhất sẽ không có cột nào ở tập tin con có tiêu đề GIỐNG tiêu đề (kể cả tiêu đề RỖNG) ở cột không lấy dữ liệu ở tập tin chính", hoặc tương đương. Anh nhé. Thứ 2 nếu các cột cần lấy trong tập tin con KHÔNG theo đúng thứ tự như trong tập tin chính thì cũng viết được code, nhận diện tiêu đề để đưa vào thì quá tốt anh à.

Do bạn không trả lời ngay nên tôi đã tự quyết định:
- lấy từ tập tin con tất cả các cột mà tiêu đề cũng có trong tập tin chính.
- các cột cần lấy từ tập tin con không nhất thiết theo đúng thứ tự như ở tập tin chính. Tức có thể theo thứ tự hoặc không. Tôi dùng từ điển chiso_tieude để ghi nhớ chỉ số cột của từng tiêu đề trong tập tin chính, vì thế dữ liệu từ tập tin con luôn bắn đúng cột trong tập tin chính. Bạn cứ thử hoán đổi vị trí của 2 cột [Hoten2] và [noiCap2] trong tậpư tin 1.xlsx rồi test xem code có bắn đúng cột trong tập tin TongHopLai.xlsm hay không.

Code chỉ xét sheet đầu tien (chỉ số 1) bất luận tập tin chính hay tập tin con có bao nhiêu sheet và chúng có tên là gì.

Hãy đọc chú thích mà tôi bỏ công ra ghi để hiểu được code và các vấn đề kỹ thuật. Sẽ có ích trong lương lai.

Mã:

Sub gop_dulieu()
Dim k As Long, lastRow As Long, r As Long, c As Long, curr_col As Long, lastCol As Long, tieude As String
Dim filename, files, cot(), dulieu(), kq(), chiso_tieude As Object, wb As Workbook
    files = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xlsx; *.xlsx", MultiSelect:=True)
    If Not IsArray(files) Then Exit Sub
    With ThisWorkbook.Worksheets(1)
        Set chiso_tieude = CreateObject("Scripting.Dictionary") ' tu dien de ghi nho tieu de trong tap tin chinh va chi so cot cua no
        chiso_tieude.comparemode = vbTextCompare
        lastRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        If lastCol < 2 Then Exit Sub    ' neu chi co cot STT thi don do choi.
        cot = .Range("A1").Resize(1, lastCol).Value
        For c = 1 To UBound(cot, 2)
            If Not chiso_tieude.exists(cot(1, c)) Then chiso_tieude.Add cot(1, c), c    ' them tieu de voi tu cach la KEY va chi so cot cua tieu de voi tu cach la ITEM
        Next c
    End With
    Application.ScreenUpdating = False
    For Each filename In files
        Set wb = Application.Workbooks.Open(filename)
        With wb.Worksheets(1)
            r = .Range("B" & Rows.Count).End(xlUp).Row
            c = .Cells(1, Columns.Count).End(xlToLeft).Column
            If r >= 2 And c >= 2 Then   ' chi thuc hien khi co du lieu
                cot = .Range("A1").Resize(1, c).Value   ' mang tieu de trong tap tin con
                dulieu = .Range("A2").Resize(r - 1, c).Value
                ReDim kq(1 To UBound(dulieu, 1), 1 To lastCol)    ' mang ket qua co so dong bang so dong trong tap tin con hien hanh va so cot bang so cot trong tap tin chinh
                For r = 1 To UBound(dulieu, 1)  ' xet tung dong cua mang du lieu
                    k = 0
                    For c = 1 To UBound(cot, 2)
                        tieude = cot(1, c)
                        If chiso_tieude.exists(tieude) Then ' neu tieu de trong tap tin con co trong tieu de trong tap tin chinh thi thuc hien
                            k = k + 1
                            curr_col = chiso_tieude.Item(tieude)    ' chi so cot cua tieu de trong tap tin chinh
                            kq(r, curr_col) = dulieu(r, c)
                        End If
                    Next c
                    If k Then   ' neu co it nhat 1 cot can nhap thi moi thuc hien
                        ThisWorkbook.Worksheets(1).Range("A" & lastRow).Resize(UBound(kq, 1), UBound(kq, 2)).Value = kq
                        lastRow = lastRow + UBound(kq, 1)   ' chi so dong bat dau nhap du lieu tu tap tin tiep theo
                    End If
                Next r
            End If
        End With
        wb.Close
    Next filename
   
    Set chiso_tieude = Nothing
    Application.ScreenUpdating = True
End Sub

THÓC SAMA đã viết:
Ai đời lại nói “quạch toẹt” ra như thế bác?!

Tôi thuộc loại dại gái. Con gái hành tôi thế nào thì cũng chịu đựng thôi.

Nga2022 · 23/7/22

Dạ em xin cảm ơn anh rất nhiều nhiều ạ.
Hãy đọc chú thích mà tôi bỏ công ra ghi để hiểu được code và các vấn đề kỹ thuật. Sẽ có ích trong lương lai. Em sẽ ghi nhớ
Mà anh xem code bài # 18 có tính năng tạo Foder anh cho chạy ra em thấy 1 số file chưa đúng anh à nhờ anh xem bị đoạn nào em với

batman1 · 24/7/22

Nga2022 đã viết:
Mà anh xem code bài # 18 có tính năng tạo Foder anh cho chạy ra em thấy 1 số file chưa đúng anh à nhờ anh xem bị đoạn nào em với

Ừ đúng, do tôi không suy nghĩ sâu và cũng không kiểm tra lại. Sau khi code ghi xong tập tin 1.xlsx thì dòng chứa tiêu đề trong mảng kq đã bị "hỏng".

Thôi tôi làm cách khác, sửa cách cũ chưa hẳn đã hay.

Mã:

Sub ghi_tung_dong()
Dim lastRow As Long, lastCol As Long, r As Long, c As Long, kq(), tieude As String, tencot As String, filename As String, files(), xoa As Range
    tieude = "[Hoten][namSinh][soGiayTo][ngayCap][noiCap][diaChiChu][Hoten2][namSinh2][soGiayTo2][ngayCap2][noiCap2][diaChiChu2]"
    Application.ScreenUpdating = False
    
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        If lastRow < 2 Then Exit Sub    ' neu chi co dong tieu de thi don do choi
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        If lastCol < 2 Then Exit Sub    ' neu chi co cot STT thi don do choi
        tao_thumuc ThisWorkbook.Path & "\Tron"
        .Copy   ' sao chep sheet hien hanh sang tap tin moi
    End With
    
    With ActiveWorkbook.Worksheets(1)   ' chinh sua tap tin moi hien hanh
        files = .Range("A1").Resize(lastRow).Value  ' cot STT chua ten cac tap tin
        For c = 1 To lastCol    ' xoa tat ca cac cot khong can lay du lieu
            tencot = .Cells(1, c).Value
            If InStr(1, tieude, tencot, vbTextCompare) = 0 Then
                If xoa Is Nothing Then
                    Set xoa = .Cells(1, c)
                Else
                    Set xoa = Union(xoa, .Cells(1, c))
                End If
            End If
        Next c
        If Not xoa Is Nothing Then xoa.EntireColumn.Delete  ' xoa cac cot khong can lay du lieu neu co
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        If .Range("A1").Value = "" Then Exit Sub    ' neu sau khi xoa cac cot khong can lay du lieu ma khong con du lieu thi don do choi
        kq = .Range("A1").Resize(lastRow, lastCol).Value    ' mang du lieu can lay, dung mang kq dong thoi lam mang ket qua
        .Range("A1").Resize(lastRow, lastCol).ClearContents ' xoa het du lieu trong tap tin hien hanh
    End With
    For r = 2 To UBound(kq, 1)
        filename = files(r, 1)
        If Len(filename) Then   ' neu ten tap tin <> RONG thi moi thuc hien
            For c = 1 To UBound(kq, 2)
                kq(2, c) = kq(r, c) ' sao chep dong r cua mang kq vao dong 2
            Next c
            ActiveWorkbook.Worksheets(1).Range("A1").Resize(2, UBound(kq, 2)).Value = kq    ' chi ghi 2 dong dau tu mang vao sheet hien hanh
            Application.DisplayAlerts = False   ' khong hien cua so khi da co tap tin voi ten hien hanh do vd. chay code lan 2
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Tron\" & filename & ".xlsx", xlOpenXMLWorkbook
            Application.DisplayAlerts = True
        End If
    Next r
    ActiveWorkbook.Close False
    Application.ScreenUpdating = True
End Sub

Nga2022 · 24/7/22

Dạ em cảm ơn anh. anh ở bên nước ngoài giờ mấy giờ rồi mà chưa ngủ hả anh.

batman1 · 24/7/22

Nga2022 đã viết:
Dạ em cảm ơn anh. anh ở bên nước ngoài giờ mấy giờ rồi mà chưa ngủ hả anh.

Ở Việt Nam 1:40 thì ở chỗ tôi là 20:40 ngày hôm trước.

Nga2022 · 24/7/22

Dạ thế thì khi nào cần sự giúp từ anh phải chờ 2, 3 giờ sáng ở việt nam anh nhỉ. Mấy năm nữa anh về. Ở bên kia mà vẫn giúp e út hết mình. Tuyệt vời anh à. Mong sao cho anh kiếm được nhiều tiền rồi về Việt Nam anh nhé.Hi

Hoàng Tuấn 868 · 24/7/22

Nga2022 đã viết:
như các anh thui,

Trước đây mình chỉ thấy có chó thui, bê thui. Giờ mới biết thêm lại có cả "các anh thui" nữa.

Xin Nhờ Anh Chị Viết em Code tách file

Thành viên mới

File đính kèm

＿/＿/＿/＿/＿/＿/＿/

Thành viên mới

File đính kèm

Đăng ký hôm qua

Thành viên gắn bó

Thành viên mới

＿/＿/＿/＿/＿/＿/＿/

Thành viên chính thức

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên gạo cội

＿/＿/＿/＿/＿/＿/＿/

Thành viên mới

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Đăng ký hôm qua