Lấy dữ liệu nhiều files từ nhiều Folders

3 Responses

1. Quick87 says:

   07/09/2024 at 3:50 pm

   em muốn lấy thêm tên fie để biết dữ liệu đó từ file nào được không bác. Cảm ơn nhiều ạ.

   Bạn thử thế này:

   Sub ABC()
     Dim sArr(), cn As Object, fRow&
     With Sheets("Sheet1")
       sArr = .Range("A2", .Range("C" & Rows.Count).End(xlUp)).Value
     End With
     Set cn = CreateObject("ADODB.Connection")
     On Error Resume Next
     With Sheets("Sheet2")
       For i = 1 To UBound(sArr)
         fRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
         cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sArr(i, 1) & ";Extended Properties=""Excel 12.0;HDR=No"";"
         .Range("A" & fRow).CopyFromRecordset cn.Execute("select *,'" & sArr(i, 1) & "' from [" & sArr(i, 2) & "$" & sArr(i, 3) & "] where f1 is not null")
         cn.Close
       Next i
     End With
     Set cn = Nothing
   End Sub

   Reply
2. killth3mallsen says:

   07/09/2024 at 3:52 pm

   Cái này nếu sheets 2 có dữ liệu nó không ghi đè lên bác nhỉ, khi các file họ cập nhật số liệu, mình muốn lấy dữ liệu mới không được, em muốn sheet 2 có dữ liệu rồi nó ghi đè lên dữ liệu cũ khi mình chạy code được không bác.
   – Ý em là ở sheet đích, nếu có sẵn dữ liệu rồi thì code nó không copy đè lên dữ liệu ở đó.
   – Em muốn chỉnh ô đầu tiên dán dữ liệu thì chỉnh thế nào bác, nó mặc định là ô A2, nhiều khi phần tiêu đề nó có 3-4 dòng thì lại không chạy được

   – Code luôn chép đè lên dữ liệu cũ tại sheet đích. Do đó, muốn khỏi lộn xộn dữ liệu mới và cũ còn sót lại thì phải xóa hết dữ liệu cũ đi rồi chép dữ liệu mới.
   => Thêm dòng này vào đầu code để xóa dữ liệu cũ:

   Sheet2.Range("A4:Z" & Sheet2.Range("A" & Rows.Count).End(xlUp).Row).ClearContents

   – Để chỉnh dòng đầu tiên dán dữ liệu thì thay dòng:

   fRow = .Range("A" & Rows.Count).End(xlUp).Row + 1

   bằng:

   If i = 1 Then
               fRow = 4
           Else
               fRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
           End If

   (fRow = 4 là dòng đầu, muốn sửa thì sửa con số này và sửa luôn Sheet2.Range("A4:Z" bên trên)

   Reply
3. killth3mallsen says:

   07/09/2024 at 3:54 pm

   Chỉnh lại code:

   Sub ABC()
     Dim sArr(), cn As Object, i&, fRow&
     With Sheets("Sheet1")
       sArr = .Range("A2", .Range("C" & Rows.Count).End(xlUp)).Value
     End With
   
   Set cn = CreateObject("ADODB.Connection")
     On Error Resume Next
     With Sheets("DanhSach")
       i = .Range("B" & Rows.Count).End(xlUp).Row
       If i > 3 Then .Range("B4:Z" & i).ClearContents 'Xoa ket qua cu
       For i = 1 To UBound(sArr)
         fRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
         If fRow < 4 Then fRow = 4
         cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sArr(i, 1) & ";Extended Properties=""Excel 12.0;HDR=No"";"
         .Range("B" & fRow).CopyFromRecordset cn.Execute("select * from [" & sArr(i, 2) & "$" & sArr(i, 3) & "] where f1 is not null")
         cn.Close
       Next i
     End With
     Set cn = Nothing
   End Sub

   Reply