Tìm trên diễn đàn cách dùng ADO mở file CSV không thấy nên chấp nhận chạy chậm
Số dòng kết bị giới hạn, nếu có thông báo thì gởi file để viết tiếp codeMã:Sub TongHop() Dim Wb As Workbook Dim pathStr As String, MyFile As String Dim Res() As String, sArr As Variant, dArr As Variant, S As Variant Dim i As Long, k As Long, eR As Long, n As Long, j As Byte Application.ScreenUpdating = False ReDim dArr(1 To 2, 1 To 1) pathStr = ThisWorkbook.Path 'Nhap duong dan truc tiep neu nam khac thu muc MyFile = Dir(pathStr & "\*.CSV") Do While MyFile <> "" k = k + 1 ReDim Preserve dArr(1 To 2, 1 To k) dArr(1, k) = MyFile MyFile = Dir() Loop For n = 1 To k Set Wb = Workbooks.Open(pathStr & "\" & dArr(1, n), , True) If Len(Range("A1").Value) Then i = Range("A" & Rows.Count).End(xlUp).Row dArr(2, n) = Range("A1:A" & i).Value eR = eR + i End If Wb.Close Next n If eR Then k = 0 ReDim Res(1 To eR, 1 To 5) For n = 1 To UBound(dArr, 2) sArr = dArr(2, n) If IsArray(sArr) Then For i = 1 To UBound(sArr) If Len(sArr(i, 1)) Then k = k + 1 S = Split(sArr(i, 1), ";") For j = 0 To UBound(S) Res(k, j + 1) = S(j) Next j End If Next i End If Next n End If i = Range("A" & Rows.Count).End(xlUp).Row If i > 2 Then Range("A3:E" & i).ClearContents If k > 1048570 Then MsgBox ("Du leu qua lon, can viet lai code, tam lay mot so dong") k = 1048570 End If Range("A3:E3").Resize(k) = Res Application.ScreenUpdating = True End Sub
Qúa nhanh, quá nguy hiểm. Cám ơn anh HieuCD đã nhiệt tình hỗ trợ kịp thời.
Code của anh chạy tốt và cũng không thấy chậm gì. Đối với bài toán ban đầu đặt ra thì anh đã giúp đỡ giải quyết xong.
Tuy nhiên từ những doạn code này lại làm mình đam mê với VBA. Mình sẽ nghiên cứu đoạn code này để học hỏi, tùy chỉnh. Nếu có gì không hiểu, rất mong anh HieuCD chỉ giúp.
Một lần nữa xin cám ơn anh HieuCD và ban quản trị https://www.giaiphapexcel.com đã có những bài viết, những hỗ trợ nhiệt tình cho mọi người có thêm những bài học và kiến thức quý báu.
Lần chỉnh sửa cuối: