Giúp copy dữ liệu hàng loạt từ các file CSV vào Excel

[madman3575]

Xin chào các thầy cô và các bạn,
Do công việc phải thường xuyên phải cập nhật dữ liệu từ các file CSV được gởi về hàng ngày, hiện tại mình phải làm thủ công (copy bằng tay từng file CSV) vào một file excel, rồi sau đó mới đưa vào dữ liệu chung...
Do đó rất mất thời gian, thông qua diễn đàn tôi cũng đang học hỏi thêm về VBA, nhưng trình độ có hạn nên không thể tạo được macro theo yêu cầu này.
Mong các thầy cô và các bạn ở GPE giúp, tôi có các file CSV và file excel mẫu kết quả đính kèm.
chân thành cảm ơn ạ.

 

[Let'GâuGâu]

Xin chào các thầy cô và các bạn,
Do công việc phải thường xuyên phải cập nhật dữ liệu từ các file CSV được gởi về hàng ngày, hiện tại mình phải làm thủ công (copy bằng tay từng file CSV) vào một file excel, rồi sau đó mới đưa vào dữ liệu chung...
Do đó rất mất thời gian, thông qua diễn đàn tôi cũng đang học hỏi thêm về VBA, nhưng trình độ có hạn nên không thể tạo được macro theo yêu cầu này.
Mong các thầy cô và các bạn ở GPE giúp, tôi có các file CSV và file excel mẫu kết quả đính kèm.
chân thành cảm ơn ạ.

trong khi chờ đợi

Option Explicit

Sub ListFiles()
    Dim objFSO, objFolder, objFile As Object
    Dim strPath, strFile As String, NextRow As Long, mainwb, wb As Workbook, lr As Long
    strPath = ThisWorkbook.Path
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strPath)
    
    If objFolder.Files.Count = 0 Then
        Exit Sub
    End If
    Set mainwb = ThisWorkbook
    For Each objFile In objFolder.Files
        If objFile Like "*.csv" Then
           Set wb = Workbooks.Open(objFile)
           lr = wb.Sheets(1).[a7].End(4).Row - 6
            mainwb.Sheets(1).[a1].End(4).Offset(1).Resize(lr, 7) = wb.Sheets(1).[a7].Resize(lr, 7)
            wb.Close False
        End If
    Next objFile
        
End Sub

 

[doveandrose]

sao cứ bị lỗi dòng này vậy bạn

mainwb.Sheets(1).[a1].End(4).Offset(1).Resize(lr, 7) = wb.Sheets(1).[a7].Resize(lr, 7)

 

[madman3575]

Việc import CSV files này chắc ít người dùng
Rất Mong anh chị nào biết về vấn đề này ghé giúp mình với.... hóng...

 

[Lê Duy Thương]

Việc import CSV files này chắc ít người dùng
Rất Mong anh chị nào biết về vấn đề này ghé giúp mình với.... hóng...

file csv thì mở bằng excel bình thường sau đó f12 đổi duôi thành xls....là được chứ import gì nhỉ

 

[madman3575]

file csv thì mở bằng excel bình thường sau đó f12 đổi duôi thành xls....là được chứ import gì nhỉ

vâng, bình thường thì mình cũng làm thế... nhưng hàng ngày có rất nhiều file và do chỉ lấy những dòng dữ liệu trong file csv thôi. Nên làm cũng hơi lâu và bất tiện...
Sẵn đang tập tành VBA nên sa vào vấn đề này luôn. Tìm hoài mà không có cách giải quyết
Cám ơn bạn đã quan tâm.

 

[doveandrose]

tưởng đâu chủ topic bỏ đi luôn rồi chứ . nếu vẫn còn thích dùng code thì lấy cái này về xem chơi

 

[madman3575]

tưởng đâu chủ topic bỏ đi luôn rồi chứ . nếu vẫn còn thích dùng code thì lấy cái này về xem chơi

Không đâu, mình đang hóng hàng ngày đó... tìm trong GPE hoài mà không thấy cái nào tương tự
Mình đã test roi, cảm ơn bạn doveandrose rất nhiều...

Nếu muốn chỉ định lại thư mục đọc file CSV thì sửa ở đây phải không? (đổi lại "C:\Libraries\Documents\" chẳng hạn)

Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)

Sao mình cứ báo lỗi nhỉ?

 

[doveandrose]

Sub ListFiles()
    Dim objFSO, objFolder, objFile As Object, c As Long, k As Long, i As Long, pathFolder As String
    Dim r As Long, n As Long, isdataRow As Boolean, isCustRow As Boolean
    Dim cnn As Object, rcst As Object, strQuery As String, arr As Variant, rsArr(1 To 100000, 1 To 10) As Variant
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set rcst = CreateObject("ADODB.Recordset")
    pathFolder = [B][COLOR=#ff0000]"E:\Downloads\Compressed\AutoTele 1.7"[/COLOR][/B]
    If Not objFSO.FolderExists(pathFolder) Then
        MsgBox "folder nay khong co that" & vbNewLine & pathFolder
        Exit Sub
    End If
    Set objFolder = objFSO.GetFolder(pathFolder)
    cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & pathFolder & _
                           ";Mode=Read;Extended Properties=""Text;HDR=NO;FMT=Delimited(,)"";"
    If objFolder.Files.Count = 0 Then
        Exit Sub
    End If
    cnn.Open
    On Error GoTo errHand
    For Each objFile In objFolder.Files
        If objFile.Name Like "*.csv" Then
            strQuery = "Select * from " & objFile.Name & " where F1 is not null or F2 is not null"
            rcst.Open strQuery, cnn
            If Not rcst.EOF Then
                arr = rcst.GetRows
                isdataRow = False
                isCustRow = False
                For r = 0 To UBound(arr, 2) Step 1
                    If Not arr(0, r) = Empty Then
                        If InStr(arr(0, r), "Total") > 0 Or InStr(arr(0, r), "Customer") > 0 _
                        Then isdataRow = False
                        If isdataRow Then
                            n = n + 1
                            For c = 0 To 6 Step 1
                                rsArr(n, c + 1) = arr(c, r)
                            Next
                        End If
                        If InStr(arr(0, r), "Sr No") > 0 Then isdataRow = True
                        
                        If InStr(arr(0, r), "Customer") > 0 Then isCustRow = True
                        If isCustRow Then
                            If k < n Then
                                For i = k + 1 To n Step 1
                                    rsArr(i, 8) = arr(1, r)
                                    rsArr(i, 9) = arr(2, r)
                                    If r < UBound(arr, 2) Then rsArr(i, 10) = arr(1, r + 1)
                                Next
                                k = n
                            End If
                            Exit For
                        End If
                    End If
                Next
            End If
            rcst.Close
        End If
    Next
    cnn.Close
    If n > 0 Then
        Application.ScreenUpdating = False
        Sheet1.Range("A1000000").End(xlUp).Offset(1).Resize(n, 10).Value = rsArr
        Application.ScreenUpdating = True
    End If
    Exit Sub
errHand:
    MsgBox "phai dong tat ca file .csv khi thuc hien code nay"
End Sub

thay dòng màu đỏ bằng thư mục nào chứa file .csv
và phải bảo đảm tất cả mọi file .csv phải chứa nội dung . sẽ lỗi nếu nội dung file .csv rỗng

 

[Let'GâuGâu]

và phải bảo đảm tất cả mọi file .csv phải chứa nội dung . sẽ lỗi nếu nội dung  file .csv rỗng[/QUOTE][QUOTE][/QUOTE]

đã lường trước hậu quả, sao ko chặn nó luôn???

 

[doveandrose]

đã lường trước hậu quả, sao ko chặn nó luôn???

cũng được mà ngại viết lại quá sao giờ . ai biểu #1 không gởi file .csv rỗng để tui chơi luôn thể . gởi sao làm vậy chứ phải

 

[madman3575]

    pathFolder = [B][COLOR=#ff0000]"E:\Downloads\Compressed\AutoTele 1.7"[/COLOR][/B]

thay dòng màu đỏ bằng thư mục nào chứa file .csv
và phải bảo đảm tất cả mọi file .csv phải chứa nội dung . sẽ lỗi nếu nội dung file .csv rỗng

1.Không hiểu sao vẫn bị lỗi:
MsgBox "phai dong tat ca file .csv khi thuc hien code nay"

2.VÀ có một phát sinh (do mình không nói rõ trong mẫu file) khi gán giá trị array của customer, nên bị gán không đúng
Mong bạn xem giúp... trong file đính kèm

 

[madman3575]

cũng được mà ngại viết lại quá sao giờ . ai biểu #1 không gởi file .csv rỗng để tui chơi luôn thể . gởi sao làm vậy chứ phải

Sorry bro, vì mình cũng không nghĩ sẽ có mấy vụ file rỗng này

 

[doveandrose]

đúng là đã có sai sót khi file .csv không chứa thông tin customer sửa lại ở file này

 

[madman3575]

đúng là đã có sai sót khi file .csv không chứa thông tin customer sửa lại ở file này

Code đã ổn,
Tiếp tục học VBA thôi... càng lúc càng bị nghiện VBA thì phải...
Cảm ơn bro doveandrose rất nhiều,

 

[dovanhoc84]

Code đã ổn,
Tiếp tục học VBA thôi... càng lúc càng bị nghiện VBA thì phải...
Cảm ơn bro doveandrose rất nhiều,

Code đã ổn,
Tiếp tục học VBA thôi... càng lúc càng bị nghiện VBA thì phải...
Cảm ơn bro doveandrose rất nhiều,

bill 3 vẫn lỗi mà madman3575?

Tôi cũng mới chập chững vào nghề nên tôi làm theo cách nghĩ của cá nhân tôi.
.Folder thì sẽ do người làm chọn ( sẽ không phải lo đến vấn đề link này kia)
.chống bill rỗng(chỉ là giả thuyết rỗng)

bạn xem file đính kèm nhé

 

[doveandrose]

bill 3 vẫn lỗi mà madman3575?

code ở trên do tôi làm . vì thế nếu có vấn đề gì cứ liên lạc với tôi . bạn vui lòng nói rõ lỗi ở đâu ?

 

[doveandrose]

.chống bill rỗng(chỉ là giả thuyết rỗng)
bạn xem file đính kèm nhé

cái gọi là chống bill rỗng của bạn là đây ?

 

[dovanhoc84]

code ở trên do tôi làm . vì thế nếu có vấn đề gì cứ liên lạc với tôi . bạn vui lòng nói rõ lỗi ở đâu ?

xin lỗi nhé, vì tôi bị nhầm đâu đó. File của bạn không lỗi gì cả.

Về phần lỗi trong file của tôi, tôi công nhận là chưa nghĩ đến tình huống trống k còn j trong csv file.
Càm ơn bạn đã chỉ

 

[madman3575]

code ở trên do tôi làm . vì thế nếu có vấn đề gì cứ liên lạc với tôi . bạn vui lòng nói rõ lỗi ở đâu ?

Mình thấy code cũng ổn rồi, nhưng muốn nâng cấp lên tí là "Hiện thư mục, chọn 1 hoặc nhiều CSV file"
Để không cần phải mỗi lần chạy macro phải đi tìm và copy file vào thư mục định sẵn...

Application.GetOpenFilename( _
                    fileFilter:=("CSV Files (*.csv), *.csv"), MultiSelect:=True)

định làm theo kiểu code này... nhưng làm mãi vẫn bị lỗi