Lấy dữ liệu từ các file data vào nhiều sheet của 1 file tổng hợp mà không cần mở (kèm điều kiện tên file data)

Liên hệ QC

APhuongS

Thành viên mới
Tham gia
23/4/14
Bài viết
19
Được thích
5
Chào các anh chị, hiện tại em đang có một trường hợp cần phải tổng hợp dữ liệu từ nhiều file Excel khác nhau nhưng có cấu trúc giống nhau vào cùng 1 file report.

Trước khi đăng bài, em có search và tìm hiểu bài đăng "Tổng hợp dữ liệu từ nhiều file excel vào 1 file không cần mở file" và search từ khóa trên Google để tìm đọc và làm theo, tuy nhiên vẫn chưa thành công vì chưa hiểu rõ và có thêm một số điều kiện khác. Vậy kính mong các anh, các chị hỗ trợ giúp em trường hợp này.

Em có file Report Consolidation.xlsx là file master tổng hợp với các sheet từ "01" --->"99" được để chung thư mục với 2 file data là "casher_*.xlsx" và "Payment_*.xlsx" ( đuôi * tên file thay đổi)
File Report này yêu cầu lấy data từ file "casher_*.xlsx" và từ file "Payment_*.xlsx".

1. Copy 2 file data tên là "casher_*.xlsx" và "Payment_*.xlsx" chung thư mục với file Report
2. Ấn Get Data,
+tự động copy value dữ liệu vùng A4:J20 sheet1 của file "Cash_*.xlsx" vào vùng C9:L25 của sheet 01 file Report
+tự động copy value dữ liệu vùng A2:G5 sheet1 của file "Payment_*.xlsx" vào vùng D37:J41 của sheet 01 file Report

(trường hợp có n file casher_* hoặc payment_* ở thư mục chung thì hiện hộp thoại báo báo xóa đi chỉ để lại 1 file, hoặc lựa 1 trong n file đó)

3.
Xóa file data cũ đi, copy file data mới vào thư mục
Vào sheet 02 của file Report, nhấn Get Data lặp lại copy như trên. Tương tự sheet 03, 04....

Mẫu file em có để ở file đính kèm ạ

Rất mong nhận được sự hỗ trợ của anh chị.
Em xin chân thành cảm ơn và mời anh chị cafe học hỏi ạ.


222877
 

File đính kèm

  • Report Consolidation.zip
    243.6 KB · Đọc: 17
Lần chỉnh sửa cuối:
Chào các anh chị, hiện tại em đang có một trường hợp cần phải tổng hợp dữ liệu từ nhiều file Excel khác nhau nhưng có cấu trúc giống nhau vào cùng 1 file report.

Trước khi đăng bài, em có search và tìm hiểu bài đăng "Tổng hợp dữ liệu từ nhiều file excel vào 1 file không cần mở file" và search từ khóa trên Google để tìm đọc và làm theo, tuy nhiên vẫn chưa thành công vì chưa hiểu rõ và có thêm một số điều kiện khác. Vậy kính mong các anh, các chị hỗ trợ giúp em trường hợp này.

Em có file Report Consolidation.xlsx là file master tổng hợp với các sheet từ "01" --->"99" được để chung thư mục với 2 file data là "casher_*.xlsx" và "Payment_*.xlsx" ( đuôi * tên file thay đổi)
File Report này yêu cầu lấy data từ file "casher_*.xlsx" và từ file "Payment_*.xlsx".

1. Copy 2 file data tên là "casher_*.xlsx" và "Payment_*.xlsx" chung thư mục với file Report
2. Ấn Get Data,
+tự động copy value dữ liệu vùng A4:J20 sheet1 của file "Cash_*.xlsx" vào vùng C9:L25 của sheet 01 file Report
+tự động copy value dữ liệu vùng A2:G5 sheet1 của file "Payment_*.xlsx" vào vùng D37:J41 của sheet 01 file Report

(trường hợp có n file casher_* hoặc payment_* ở thư mục chung thì hiện hộp thoại báo báo xóa đi chỉ để lại 1 file, hoặc lựa 1 trong n file đó)

3.
Xóa file data cũ đi, copy file data mới vào thư mục
Vào sheet 02 của file Report, nhấn Get Data lặp lại copy như trên. Tương tự sheet 03, 04....

Mẫu file em có để ở file đính kèm ạ

Rất mong nhận được sự hỗ trợ của anh chị.
Em xin chân thành cảm ơn và mời anh chị cafe học hỏi ạ.


View attachment 222877
Mã:
Sub GopData()
  Dim FSo As Object, cn As Object, n As Long
  Dim iPath$, ShName$, FileName$, ShRng$, fName1$, RngAddress1$, fName2$, RngAddress2$
 
  iPath = ThisWorkbook.Path & "\"
  ShName = "Sheet1"
  fName1 = "casher_":       RngAddress1 = "$A4:J20"
  fName2 = "Payment_":     RngAddress2 = "$A2:G11"
 
  Set FSo = CreateObject("Scripting.FileSystemObject")
  Set cn = CreateObject("ADODB.Connection")
  For n = 1 To ThisWorkbook.Sheets.Count
    FileName = iPath & fName1 & Sheets(n).Name & ".xlsx"
    If FSo.FileExists(FileName) Then
      ShRng = ShName & RngAddress1
      On Error Resume Next
      cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";Extended Properties=""Excel 12.0;HDR=No"";"
      sqlStr = "Select * From [" & ShRng & "] where f2 is not null"
      Sheets(n).Range("C9").CopyFromRecordset cn.Execute(sqlStr)
      cn.Close
      On Error GoTo 0
    End If
    
    FileName = iPath & fName2 & Sheets(n).Name & ".xlsx"
    If FSo.FileExists(FileName) Then
      ShRng = ShName & RngAddress2
      On Error Resume Next
      cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";Extended Properties=""Excel 12.0;HDR=No"";"
      sqlStr = "Select * From [" & ShRng & "] where f2 is not null"
      a = Err.Number
      Sheets(n).Range("D37").CopyFromRecordset cn.Execute(sqlStr)
      cn.Close
      On Error GoTo 0
    End If
  Next n
  Set cn = Nothing: Set FSo = Nothing
End Sub
 

File đính kèm

  • Report Consolidation.xlsm
    103 KB · Đọc: 17
Upvote 0
Mã:
Sub GopData()
  Dim FSo As Object, cn As Object, n As Long
  Dim iPath$, ShName$, FileName$, ShRng$, fName1$, RngAddress1$, fName2$, RngAddress2$

  iPath = ThisWorkbook.Path & "\"
  ShName = "Sheet1"
  fName1 = "casher_":       RngAddress1 = "$A4:J20"
  fName2 = "Payment_":     RngAddress2 = "$A2:G11"

  Set FSo = CreateObject("Scripting.FileSystemObject")
  Set cn = CreateObject("ADODB.Connection")
  For n = 1 To ThisWorkbook.Sheets.Count
    FileName = iPath & fName1 & Sheets(n).Name & ".xlsx"
    If FSo.FileExists(FileName) Then
      ShRng = ShName & RngAddress1
      On Error Resume Next
      cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";Extended Properties=""Excel 12.0;HDR=No"";"
      sqlStr = "Select * From [" & ShRng & "] where f2 is not null"
      Sheets(n).Range("C9").CopyFromRecordset cn.Execute(sqlStr)
      cn.Close
      On Error GoTo 0
    End If
   
    FileName = iPath & fName2 & Sheets(n).Name & ".xlsx"
    If FSo.FileExists(FileName) Then
      ShRng = ShName & RngAddress2
      On Error Resume Next
      cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";Extended Properties=""Excel 12.0;HDR=No"";"
      sqlStr = "Select * From [" & ShRng & "] where f2 is not null"
      a = Err.Number
      Sheets(n).Range("D37").CopyFromRecordset cn.Execute(sqlStr)
      cn.Close
      On Error GoTo 0
    End If
  Next n
  Set cn = Nothing: Set FSo = Nothing
End Sub
Trước tiên, em xin chân thành cảm ơn anh @HieuCD đã hỗ trợ em ạ.

Mã code trên rất hiệu quả, song em bị mắc ở file data anh Hiếu ạ.
Em có trình bày 2 file data là "casher_*.xlsx" và "Payment_*.xlsx" ( đuôi * thay đổi liên tục)

Ví dụ Payment_01, casher_01; casher_02, Payment_02 ; Payment_03 casher_03; tương ứng với sheet 01, 02, 03 trong file Report ạ

Thực tế là phần đuôi theo đổi theo ngày tải xuống như Payment_20190801.xlsx, casher_20190803.xlsx ==>data vào sheet 01 file report
Payment_20190804.xlsx, casher_20190805 (1).xlsx ==> data vào sheet 02 file report

(trường hợp có n file casher_* hoặc payment_* ở thư mục chung thì hiện hộp thoại báo báo xóa đi chỉ để lại 1 file, hoặc lựa 1 trong n file đó)
 
Upvote 0
Trước tiên, em xin chân thành cảm ơn anh @HieuCD đã hỗ trợ em ạ.

Mã code trên rất hiệu quả, song em bị mắc ở file data anh Hiếu ạ.
Em có trình bày 2 file data là "casher_*.xlsx" và "Payment_*.xlsx" ( đuôi * thay đổi liên tục)

Ví dụ Payment_01, casher_01; casher_02, Payment_02 ; Payment_03 casher_03; tương ứng với sheet 01, 02, 03 trong file Report ạ

Thực tế là phần đuôi theo đổi theo ngày tải xuống như Payment_20190801.xlsx, casher_20190803.xlsx ==>data vào sheet 01 file report
Payment_20190804.xlsx, casher_20190805 (1).xlsx ==> data vào sheet 02 file report

(trường hợp có n file casher_* hoặc payment_* ở thư mục chung thì hiện hộp thoại báo báo xóa đi chỉ để lại 1 file, hoặc lựa 1 trong n file đó)
"
Thực tế là phần đuôi theo đổi theo ngày tải xuống như Payment_20190801.xlsx, casher_20190803.xlsx ==>data vào sheet 01 file report
Payment_20190804.xlsx, casher_20190805 (1).xlsx ==> data vào sheet 02 file report"
Làm sao biết đuôi nào vào sheet nào?
 
Upvote 0
"
Thực tế là phần đuôi theo đổi theo ngày tải xuống như Payment_20190801.xlsx, casher_20190803.xlsx ==>data vào sheet 01 file report
Payment_20190804.xlsx, casher_20190805 (1).xlsx ==> data vào sheet 02 file report"
Làm sao biết đuôi nào vào sheet nào?

Dạ, thực tế em chỉ copy 1 file payment_* và 1 file casher_* vào thư mục chung file Report, gộp data xong sẽ xóa file data cũ luôn ạ
Với sheet 02 thì em sẽ copy file data mới vào thư mục đó và gộp tương tự ạ

Vậy nên em có trình bày trường hợp có >=2 file casher_* hoặc >=2 file payment_* ở thư mục chung thì hiện hộp thoại báo báo xóa đi chỉ để lại 1 file, hoặc lựa 1 trong n file đó.
 
Upvote 0
"
Thực tế là phần đuôi theo đổi theo ngày tải xuống như Payment_20190801.xlsx, casher_20190803.xlsx ==>data vào sheet 01 file report
Payment_20190804.xlsx, casher_20190805 (1).xlsx ==> data vào sheet 02 file report"
Làm sao biết đuôi nào vào sheet nào?
Dạ, thực tế file data của em name Sheet mặc định là "Sheet 1"
Em đã sửa ShName thêm khoảng trắng giữa "Sheet" và "1", nhưng khi cho chạy lại macro code lại không chạy.


Mã:
 iPath = ThisWorkbook.Path & "\"
  ShName = "Sheet 1"
  fName1 = "casher_":


Trường hợp theo code cũ thì phải bật file đổi từ "Sheet 1" thành "Sheet1" thì lại ok. Mong bác HieuCD chỉ giáo ạ
 
Upvote 0
Dạ, thực tế file data của em name Sheet mặc định là "Sheet 1"
Em đã sửa ShName thêm khoảng trắng giữa "Sheet" và "1", nhưng khi cho chạy lại macro code lại không chạy.


Mã:
 iPath = ThisWorkbook.Path & "\"
  ShName = "Sheet 1"
  fName1 = "casher_":


Trường hợp theo code cũ thì phải bật file đổi từ "Sheet 1" thành "Sheet1" thì lại ok. Mong bác HieuCD chỉ giáo ạ
Tại sao phải copy rồi lại Xóa File?
Code chọn trực tiếp File dữ liệu,
Mã:
Sub GopData()
  Dim fd As Object, cn As Object, S
  Dim iPath$, ShName$, FileName, ShRng$
  Dim casher_Name$, casher_Address$, Payment_Name$, Payment_Address$
  Dim casher_Bln As Boolean, Payment_Bln As Boolean
  iPath = ThisWorkbook.Path & "\"
  ShName = "Sheet 1" 'Ten cac sheet du lieu
  casher_Name = "casher_":       casher_Address = "$A4:J20"
  Payment_Name = "Payment_":     Payment_Address = "$A2:G11"
 
  Set fd = Application.FileDialog(msoFileDialogFilePicker)
  With fd
    .AllowMultiSelect = True
    If .Show = -1 Then
      Set tmp = .SelectedItems
    Else
      MsgBox ("Chua chon File"): Set fd = Nothing: Exit Sub
    End If
  End With
  Set cn = CreateObject("ADODB.Connection")
  For Each FileName In tmp
    S = Split(FileName, "\")
    If casher_Bln = False Then
      If S(UBound(S)) Like casher_Name & "*" Then
        ShRng = ShName & casher_Address
        Call KetQua(cn, FileName, ShRng, "C9")
        casher_Bln = True
      End If
    End If
    If Payment_Bln = False Then
      If S(UBound(S)) Like Payment_Name & "*" Then
        ShRng = ShName & Payment_Address
        Call KetQua(cn, FileName, ShRng, "D37")
        Payment_Bln = True
      End If
    End If
    If casher_Bln And Payment_Bln Then Exit For
  Next
  Set fd = Nothing: Set cn = Nothing
End Sub

Private Sub KetQua(ByRef cn, ByVal FileName$, ByVal ShRng$, ByVal RngResul$)
    On Error Resume Next
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";Extended Properties=""Excel 12.0;HDR=No"";"    
    Range(RngResul).CopyFromRecordset cn.Execute("Select * From [" & ShRng & "]")
    cn.Close
    On Error GoTo 0
End Sub
không xóa file đã dùng. Nhấn phím Ctrl để chọn nhiều File
 

File đính kèm

  • Report Consolidation.xlsm
    104.4 KB · Đọc: 20
Upvote 0
Tại sao phải copy rồi lại Xóa File?
Code chọn trực tiếp File dữ liệu,
Mã:
Sub GopData()
  Dim fd As Object, cn As Object, S
  Dim iPath$, ShName$, FileName, ShRng$
  Dim casher_Name$, casher_Address$, Payment_Name$, Payment_Address$
  Dim casher_Bln As Boolean, Payment_Bln As Boolean
  iPath = ThisWorkbook.Path & "\"
  ShName = "Sheet 1" 'Ten cac sheet du lieu
  casher_Name = "casher_":       casher_Address = "$A4:J20"
  Payment_Name = "Payment_":     Payment_Address = "$A2:G11"

  Set fd = Application.FileDialog(msoFileDialogFilePicker)
  With fd
    .AllowMultiSelect = True
    If .Show = -1 Then
      Set tmp = .SelectedItems
    Else
      MsgBox ("Chua chon File"): Set fd = Nothing: Exit Sub
    End If
  End With
  Set cn = CreateObject("ADODB.Connection")
  For Each FileName In tmp
    S = Split(FileName, "\")
    If casher_Bln = False Then
      If S(UBound(S)) Like casher_Name & "*" Then
        ShRng = ShName & casher_Address
        Call KetQua(cn, FileName, ShRng, "C9")
        casher_Bln = True
      End If
    End If
    If Payment_Bln = False Then
      If S(UBound(S)) Like Payment_Name & "*" Then
        ShRng = ShName & Payment_Address
        Call KetQua(cn, FileName, ShRng, "D37")
        Payment_Bln = True
      End If
    End If
    If casher_Bln And Payment_Bln Then Exit For
  Next
  Set fd = Nothing: Set cn = Nothing
End Sub

Private Sub KetQua(ByRef cn, ByVal FileName$, ByVal ShRng$, ByVal RngResul$)
    On Error Resume Next
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";Extended Properties=""Excel 12.0;HDR=No"";"   
    Range(RngResul).CopyFromRecordset cn.Execute("Select * From [" & ShRng & "]")
    cn.Close
    On Error GoTo 0
End Sub
không xóa file đã dùng. Nhấn phím Ctrl để chọn nhiều File
Tại sao phải copy rồi lại Xóa File?
Code chọn trực tiếp File dữ liệu,
Mã:
Sub GopData()
  Dim fd As Object, cn As Object, S
  Dim iPath$, ShName$, FileName, ShRng$
  Dim casher_Name$, casher_Address$, Payment_Name$, Payment_Address$
  Dim casher_Bln As Boolean, Payment_Bln As Boolean
  iPath = ThisWorkbook.Path & "\"
  ShName = "Sheet 1" 'Ten cac sheet du lieu
  casher_Name = "casher_":       casher_Address = "$A4:J20"
  Payment_Name = "Payment_":     Payment_Address = "$A2:G11"

  Set fd = Application.FileDialog(msoFileDialogFilePicker)
  With fd
    .AllowMultiSelect = True
    If .Show = -1 Then
      Set tmp = .SelectedItems
    Else
      MsgBox ("Chua chon File"): Set fd = Nothing: Exit Sub
    End If
  End With
  Set cn = CreateObject("ADODB.Connection")
  For Each FileName In tmp
    S = Split(FileName, "\")
    If casher_Bln = False Then
      If S(UBound(S)) Like casher_Name & "*" Then
        ShRng = ShName & casher_Address
        Call KetQua(cn, FileName, ShRng, "C9")
        casher_Bln = True
      End If
    End If
    If Payment_Bln = False Then
      If S(UBound(S)) Like Payment_Name & "*" Then
        ShRng = ShName & Payment_Address
        Call KetQua(cn, FileName, ShRng, "D37")
        Payment_Bln = True
      End If
    End If
    If casher_Bln And Payment_Bln Then Exit For
  Next
  Set fd = Nothing: Set cn = Nothing
End Sub

Private Sub KetQua(ByRef cn, ByVal FileName$, ByVal ShRng$, ByVal RngResul$)
    On Error Resume Next
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";Extended Properties=""Excel 12.0;HDR=No"";"   
    Range(RngResul).CopyFromRecordset cn.Execute("Select * From [" & ShRng & "]")
    cn.Close
    On Error GoTo 0
End Sub
không xóa file đã dùng. Nhấn phím Ctrl để chọn nhiều File
Cám ơn anh @HieuCD
Code hoạt động thành công ạ.

Song em bị mắc là tải file từ hệ thống xuống thì rồi chạy thì vẫn không nhận data.
Phải bật file data lên can thiệp tên sheet thêm vài ký tự rồi xóa đi rồi Save lại thì lại hoạt động.

Ví dụ. Em tải file data về, bật lên sửa name "Sheet 1" bằng cách thêm/xóa bất kỳ ký tự gì "Sheet 1234"rồi undo thao tác về "Sheet 1", Save lại. Chạy vba file report thì ok.

Em chưa xác định được lỗi từ đâu. Có cách đổi cách nhận diện name Sheet thành code Sheet không ạ, vì file data e tải về đúng 1 sheet tên như trên thôi ạ.
 
Upvote 0
Cám ơn anh @HieuCD
Code hoạt động thành công ạ.

Song em bị mắc là tải file từ hệ thống xuống thì rồi chạy thì vẫn không nhận data.
Phải bật file data lên can thiệp tên sheet thêm vài ký tự rồi xóa đi rồi Save lại thì lại hoạt động.

Ví dụ. Em tải file data về, bật lên sửa name "Sheet 1" bằng cách thêm/xóa bất kỳ ký tự gì "Sheet 1234"rồi undo thao tác về "Sheet 1", Save lại. Chạy vba file report thì ok.

Em chưa xác định được lỗi từ đâu. Có cách đổi cách nhận diện name Sheet thành code Sheet không ạ, vì file data e tải về đúng 1 sheet tên như trên thôi ạ.
Bạn gởi các file data xuất từ phần mềm để mình kiểm tra tên sheet, dữ liệu có thể xóa cho nhẹ file
 
Upvote 0
Bạn gởi các file data xuất từ phần mềm để mình kiểm tra tên sheet, dữ liệu có thể xóa cho nhẹ file
Dạ, ok anh. Em gửi anh file data ạ. Anh kiểm tra giúp em.
Em open file data, thêm, xóa rồi SAVE lại thì Report gộp data được. Còn không thao tác thì ko chạy ạ.
 

File đính kèm

  • File Data.zip
    90.2 KB · Đọc: 17
Upvote 0
Dạ, vậy không có cách nào khác để chạy VBA được ạ :(
Chỉnh địa chỉ vùng copy cho phù hợp
Mã:
Sub GopData()
  Dim fd As Object, wb As Workbook, tmp, cRng As Range, pRng As Range, S
  Dim ShName$, FileName, ShRng$
  Dim casher_Name$, casher_Address$, Payment_Name$, Payment_Address$
  Dim casher_Bln As Boolean, Payment_Bln As Boolean

  casher_Name = "Casher_":       casher_Address = "A4:J20"
  Payment_Name = "Payment_":     Payment_Address = "A4:G13"
  Set cRng = Range("C9")
  Set pRng = Range("D37")
  Set fd = Application.FileDialog(msoFileDialogFilePicker)
  With fd
    .AllowMultiSelect = True
    If .Show = -1 Then
      Set tmp = .SelectedItems
    Else
      MsgBox ("Chua chon File"): Set fd = Nothing: Exit Sub
    End If
  End With
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  For Each FileName In tmp
    S = Split(FileName, "\")
    If casher_Bln = False Then
      If S(UBound(S)) Like casher_Name & "*" Then
        Set wb = Workbooks.Open(FileName, False, True)
        Range(casher_Address).Copy cRng
        casher_Bln = True
        wb.Close fals
      End If
    End If
    If Payment_Bln = False Then
      If S(UBound(S)) Like Payment_Name & "*" Then
        Set wb = Workbooks.Open(FileName, False, True)
        Range(Payment_Address).Copy pRng
        Payment_Bln = True
        wb.Close fals
      End If
    End If
    If casher_Bln And Payment_Bln Then Exit For
  Next
  Set fd = Nothing
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub
 
Upvote 0
Cũng với bài toán giống như trên, nhưng file data của mình có nhiều sheet, mình muốn chọn 1 sheet thì có cách nào ko anh @HieuCD ??
 
Upvote 0
Web KT
Back
Top Bottom