Xin Nhờ Anh Chị Viết em Code tách file (1 người xem)

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]

Nga2022 · 21/7/22

Cả nhà ơi cả nhà giúp em với lần đầu tham gia diễn đàn mà không có ai ngó ngàng buồn quá

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

Nga2022 đã viết:
Cả nhà ơi cả nhà giúp em với lần đầu tham gia diễn đàn mà không có ai ngó ngàng buồn quá

Các thành viên còn đang giúp những người nhờ trước bạn, khi nào xong thì đến lượt bạn thôi.

snow25 · 21/7/22

Nga2022 đã viết:
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]

Nhất thiết phải tách sang work à bạn.

Nga2022 · 21/7/22

Dạ không anh ơi tách sang file excel anh à

VetMini · 21/7/22

Bạn lập thử một file giả tạo. Cỡ 20 dòng dữ liệu.
Sau đó bạn lập cách files như được tách ra.
Người ta sẽ dựa vào ví dụ ấy mà viết code cho bạn.

Chớ lười biếng. Làm files ví dụ như vậy không tốn công và thì giờ nhiều hơn người ta viết code giùm bạn đâu.

Nga2022 · 21/7/22

Dạ Vâng anh. em giử Các anh các chị một số file kết quả sau khi tách ra như sau ạ
Mong anh chị giúp em với. Em xin cảm ơn anh chị nhiều ạ

Nga2022 · 21/7/22

Mong ngóng Các anh các chị trong diễn đàn code giúp e với

batman1 · 22/7/22

Nga2022 đã viết:
Mong ngóng Các anh các chị trong diễn đàn code giúp e với

Trong lúc chờ đợi các anh chị thì bạn thử code sau.

Ví dụ thêm 1 Module và dán vào code sau

Mã:

Sub ghi_1_dong()
Dim lastRow As Long, r As Long, rng As Range, sh As Worksheet
    Application.ScreenUpdating = False
   
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    With sh
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        If lastRow < 2 Then Exit Sub
        .Copy
    End With
    Set rng = ActiveWorkbook.Worksheets(1).UsedRange.Offset(1)
    rng.ClearContents
    Set rng = rng.Resize(1)
   
    Application.DisplayAlerts = False   ' khong hien cua so khi da co tap tin voi ten hien hanh do vd. chay code lan 2
    For r = 2 To lastRow
        rng.Value = sh.Range("A" & r).Resize(1, rng.Columns.Count).Value
        rng.Parent.SaveAs ThisWorkbook.Path & "\" & sh.Range("A" & r).Value & ".xlsx", xlOpenXMLWorkbook
    Next r
    rng.Parent.Parent.Close
    Application.DisplayAlerts = True
   
    Application.ScreenUpdating = True
End Sub

Nga2022 · 22/7/22

Cảm ơn anh em xin nhờ anh sửa code chỉ lấy những cột có ký tự tiêu đề riêng sau

[So TT]

[Hoten]

[namSinh]

[soGiayTo]

[ngayCap]

[noiCap]

[diaChiChu]

[Hoten2]

[namSinh2]

[soGiayTo2]

[ngayCap2]

[noiCap2]

[diaChiChu2]

( 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).

Nga2022 · 22/7/22

Anh batman1 anh có bổ sung code cho em 1 cái hộp thoại chọn dòng không anh. như hình dưới đây anh À. Xin cảm ơn anh nhiều

batman1 · 22/7/22

Nga2022 đã viết:
Anh batman1 anh có bổ sung code cho em 1 cái hộp thoại chọn dòng không anh. như hình dưới đây anh À. Xin cảm ơn anh nhiều

1. Nếu thêm bớt tiêu đề cần lấy thì thêm bớt sau dấu bằng "="

Mã:

tieude = "[Hoten][namSinh][soGiayTo][ngayCap][noiCap][diaChiChu][Hoten2][namSinh2][soGiayTo2][ngayCap2][noiCap2][diaChiChu2]"

2. Các tiêu đề liệt kê ở trên phải theo đúng thứ tự trước sau giống như trong tập tin gốc.

3.

Mã:

Sub ghi_1_dong()
Dim lastRow As Long, lastCol As Long, c As Long, k As Long, dong As Long, kq(), rng As Range, tieude As String, tencot As String
    tieude = "[Hoten][namSinh][soGiayTo][ngayCap][noiCap][diaChiChu][Hoten2][namSinh2][soGiayTo2][ngayCap2][noiCap2][diaChiChu2]"
    Application.ScreenUpdating = False
  
'    Set sh = ThisWorkbook.Worksheets("Sheet1")
    With ThisWorkbook.Worksheets("Sheet1")
        On Error Resume Next
        Set rng = Application.InputBox(prompt:="Hay chon mot o cua dong hien hanh", Type:=8)
        If rng Is Nothing Then Exit Sub ' neu khong chon thi nghi choi
        On Error GoTo 0
        dong = rng.Row
        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
        Set rng = .Range("B1").Resize(1, lastCol - 1)  ' lay tu cot B - dong tieu de trong tap tin goc
        ReDim kq(1 To 2, 1 To rng.Columns.Count)    ' mang ket qua co so cot nhieu nhat la bang so cot TIEU DE tinh tu cot B
       
        For c = 1 To rng.Count
            tencot = rng(c).Value
            If InStr(1, tieude, tencot, vbTextCompare) Then ' neu tieu de cot trong tap tin goc la tieu de can lay
                k = k + 1
                kq(1, k) = tencot   ' tieu de cot
                kq(2, k) = rng(c).Offset(dong - 1).Value    ' gia tri
            End If
        Next c
        If k Then
            Application.Workbooks.Add   ' them tap tin moi
            ActiveWorkbook.Worksheets(1).Range("A1").Resize(2, k).Value = kq
            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 & "\" & rng(1).Offset(dong - 1, -1).Value & ".xlsx", xlOpenXMLWorkbook
            ActiveWorkbook.Close False
            Application.DisplayAlerts = True
        End If
    End With
    Application.ScreenUpdating = True
End Sub

4. Các tập tin được lưu trong thư mục có tập tin gốc.

Nga2022 · 22/7/22

Hay quá anh chỉ xin anh viết tiếp cho em 1 code chạy toàn bộ các dòng cũng dựa vào tiêu đề này và tự động tạo foder có trên là Tron
Em xin chân thành cảm ơn anh

batman1 · 22/7/22

Nga2022 đã viết:
Hay quá anh chỉ xin anh viết tiếp cho em 1 code chạy toàn bộ các dòng cũng dựa vào tiêu đề này và tự động tạo foder có trên là Tron
Em xin chân thành cảm ơn anh

Có nghĩa không chọn dòng cụ thể nữa mà ghi cho tất cả các dòng? Tạo thư mục Tron ở đâu?

Có khi tối (hiện chỗ tôi là 13:24) tôi mới có thời gian.

Nếu là Mail Merge của Word thì chịu khó học đi. Dùng code VBA của người khác thay cho Mail Merge thì cũng không phải toàn hoa hồng như người ta giới thiệu đâu. Mà cái cớ Mail Merge khó thì có vẻ hài quá. Viện cớ là chọn Mailing xong không biết làm gì tiếp, khi chỉ là Insert Merge Field, thì có câu hỏi. Khi dùng code VBA của người khác không cần tìm hiểu, học, luyện tới hộc cơm?

ongke0711 · 22/7/22

Chủ thớt này có vẻ quen..

. Bạn tạo nick khác để hỏi thêm bài à.

batman1 · 22/7/22

ongke0711 đã viết:
Chủ thớt này có vẻ quen... Bạn tạo nick khác để hỏi thêm bài à.

Thời nay mấy em gái cũng lanh lợi chứ không như ngày xưa đâu.

Hoặc là anh chàng nào đấy làm rồi "đổ thừa" cho mấy em gái hiền dịu.

Nga2022 · 22/7/22

Ủa anh đi làm ở nước ngoài à anh. Không phải dùng Mail Merge của Word anh à. Dùng lưu trữ dữ liệu anh à
Thêm chức năng ghi cho tất cả các dòng và tao foder như hình vẽ anh à.

batman1 · 22/7/22

Tôi lười nên không viết mới mà chỉ sửa code đã có trước đó.

Tôi sửa lại code sau khi có báo cáo lỗi ở bài #35

Mã:

Sub tao_thumuc(ByVal foldername As String)
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(foldername) Then fso.CreateFolder (foldername)
    Set fso = Nothing
End Sub

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 · 22/7/22

Cảm ơn anh. Lúc đầu em không nghỉ ra Giờ muốn Import lại các file đã xuất ra theo những cột có ký tự tiêu đề riêng mà code trên đã chạy ra để tổng hợp thì code như thế nào anh chứ ngồi mở từng file copy thì lâu lắm anh ơi (Bài toán ngược lại anh à)

batman1 · 23/7/22

Nga2022 đã viết:
Cảm ơn anh. Lúc đầu em không nghỉ ra Giờ muốn Import lại các file đã xuất ra theo những cột có ký tự tiêu đề riêng mà code trên đã chạy ra để tổng hợp thì code như thế nào anh chứ ngồi mở từng file copy thì lâu lắm anh ơi (Bài toán ngược lại anh à)

Tôi cho phép bạn nghĩ thật kỹ và nói hết trong 1 bài nữa. Sau đó tôi chỉ giúp bạn lần cuối. Không có chuyện rồi bạn thêm yêu cầu, "không nghĩ ra". Tôi không ngồi chờ để cầy hộ bạn.
Muốn có code cho "bài toán ngược lại" thì giải thích kỹ nó là gì. Dữ liệu đầu vào là gì, lấy từ đâu. Có cái đó thì những bước tiếp theo phải làm gì. Tức liệ́t kê tất cả các bước nếu làm bằng tay. Nếu tôi hiểu thì tôi giụ́p, không hiểu thì thôi. Không có chuyện tôi lại phải van nài, hướng dẫn cách cung cấp thông tin.

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.

Nga2022 · 24/7/22

Anh ơi em sáng nay em có đọc 1 bài trên gpe. mà em muốn xin nhờ anh khai báo biến I và biến khác luôn luôn chạy dưới dòng có ký tự tiêu đề [Ten][Ngaythang]...........[Diachimoi]. (Bản chất em muốn là sau này chèn dòng xóa dòng thì biến I khác luôn luôn sẽ chạy dưới ký tự tiêu đề nên không phải sửa địa chỉ ô trong code ạ). em giử file và hình ảnh ạ. có gì mạo muội anh và tác giả cả nhà GPE thông cảm em với ạ
Em xin chân thành cảm ơn anh nhiều ạ

batman1 · 24/7/22

Nga2022 đã viết:
Anh ơi em sáng nay em có đọc 1 bài trên gpe. mà em muốn xin nhờ anh khai báo biến I và biến khác luôn luôn chạy dưới dòng có ký tự tiêu đề [Ten][Ngaythang]...........[Diachimoi]. (Bản chất em muốn là sau này chèn dòng xóa dòng thì biến I khác luôn luôn sẽ chạy dưới ký tự tiêu đề nên không phải sửa địa chỉ ô trong code ạ). em giử file và hình ảnh ạ. có gì mạo muội anh và tác giả cả nhà GPE thông cảm em với ạ
Em xin chân thành cảm ơn anh nhiều ạ

1. Theo nội qui phải lập chủ đề mới cho vấn đề mới.

2. Code lấy ở đâu thì vào đấy hỏi, lấy của ai thì hỏi người đó.

3. Trích bài #14

Nếu là Mail Merge của Word thì chịu khó học đi. Dùng code VBA của người khác thay cho Mail Merge thì cũng không phải toàn hoa hồng như người ta giới thiệu đâu. Mà cái cớ Mail Merge khó thì có vẻ hài quá. Viện cớ là chọn Mailing xong không biết làm gì tiếp, khi chỉ là Insert Merge Field, thì có câu hỏi. Khi dùng code VBA của người khác không cần tìm hiểu, học, luyện tới hộc cơm?

Nga2022 · 24/7/22

Dạ. em chỉ xin anh cho em 1 vài câu lệnh khai báo biến i đó thui ạ. Để em nghiên cứu học tập thôi anh à

Xin Nhờ Anh Chị Viết em Code tách file (1 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

File đính kèm

Thành viên mới

Đăng ký hôm qua

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

Thành viên mới

Đang đi tìm hòn đá

Thành viên mới

File đính kèm

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 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 gắn bó

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

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

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ời gian đếm ngược.