Hỏi cách nối dữ liệu từ nhiều file excel có cấu trúc giống nhau thành 1 file?

[nhunguyet0103]

Em có các file dữ liệu phổ cập của các khu file dạng excel (Xuất ra từ hệ thống như đính kèm) bây giờ em muốn copy dữ liệu của tất cả các file vào file Tong hop.xls thì viết code cho nút Get Data trong file Tong hop.xls như thế nào ạ? Các bác chỉ giúp em với!! Thanks!
(Em đang tham khảo code theo hướng dẫn ở bài: http://www.giaiphapexcel.com/dienda...nhiều-file-excel-vào-1-file-không-cần-mở-file nhưng chưa được ạ)

 

[AnhPhong411]

Em có các file dữ liệu phổ cập của các khu file dạng excel (Xuất ra từ hệ thống như đính kèm) bây giờ em muốn copy dữ liệu của tất cả các file vào file Tong hop.xls thì viết code cho nút Get Data trong file Tong hop.xls như thế nào ạ? Các bác chỉ giúp em với!! Thanks!
(Em đang tham khảo code theo hướng dẫn ở bài: http://www.giaiphapexcel.com/dienda...nhiều-file-excel-vào-1-file-không-cần-mở-file nhưng chưa được ạ)

Bạn thử cách này xem nhé, ở đây là tổng hợp trong 1 file, bạn cần tìm hiểu thêm về DBKEY trong BS_SQL nữa là được nhé.
Link: http://bluesofts.net/kien-thuc-excel/465-gop-du-lieu-tu-nhieu-bang-trong-excel.html

 

[nhunguyet0103]

Bạn thử cách này xem nhé, ở đây là tổng hợp trong 1 file, bạn cần tìm hiểu thêm về DBKEY trong BS_SQL nữa là được nhé.
Link: http://bluesofts.net/kien-thuc-excel/465-gop-du-lieu-tu-nhieu-bang-trong-excel.html

Vâng! Em cảm ơn bác ạ!

 

[nhunguyet0103]

Vẫn chẳng làm được! Các bác giúp em với! Thanks!

 

[be_09]

Vẫn chẳng làm được! Các bác giúp em với! Thanks!

Dùng thử File này xem sao, lưu ý khi sử dụng File:

1/ Tên thư mục (cha) là THEO DOI PHIEU DIEU TRA (Để trong ổ D), trong thư mục cha chứa File Tong hop và thư mục (con) DL cac khu.

2/ Thư mục (con) DL cac khu: Chứa các File Khu1, Khu2, Khu3 ..v..v...

3/ Đổi tên sheet Danh sách phiếu điều tra (không nên đặt tên sheet có dấu) của các File Khu1, Khu2, Khu3 thành DS_PHIEUDIEUTRA.

 

[nhunguyet0103]

Dùng thử File này xem sao, lưu ý khi sử dụng File:

1/ Tên thư mục (cha) là THEO DOI PHIEU DIEU TRA (Để trong ổ D), trong thư mục cha chứa File Tong hop và thư mục (con) DL cac khu.

2/ Thư mục (con) DL cac khu: Chứa các File Khu1, Khu2, Khu3 ..v..v...

3/ Đổi tên sheet Danh sách phiếu điều tra (không nên đặt tên sheet có dấu) của các File Khu1, Khu2, Khu3 thành DS_PHIEUDIEUTRA.

Em cảm ơn bác nhiều...nhiều ạ! hướng dẫn của bác rất đúng với yêu cầu của em ạ! Nhưng em muốn hỏi thêm: Có thể viết code để tự động làm công việc của mục 3/ ở trên không ạ!
(vì khi xuất các file của các khu từ hệ thống phổ cập xóa mù chữ của Bộ GD thì tên của các sheet đó đã như vậy rồi ạ!)

 

[HieuCD]

Vẫn chẳng làm được! Các bác giúp em với! Thanks!

bạn chạy thử code

Option Explicit
Sub TongHop()
Dim WB As Workbook, Fso As Object, ObjFoder As Object, ObjFile As Object, Darr(), i As Long
Range("B5:AY10000").Clear
Application.ScreenUpdating = False
Set Fso = CreateObject("Scripting.FileSystemObject")
Set ObjFoder = Fso.GetFolder(ThisWorkbook.Path)
For Each ObjFile In ObjFoder.Files
  If ObjFile.Name <> ThisWorkbook.Name And Fso.GetExtensionName(ObjFile) Like "xls*" Then
    Set WB = Workbooks.Open(ObjFile)
    Darr = Range("B5:AY" & Range("B5000").End(xlUp).Row).Value
    WB.Close False
    Range("B6500").End(xlUp).Offset(1, 0).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
    i = i + UBound(Darr)
  End If
Next
ReDim Darr(1 To i, 1 To 1)
For i = 1 To UBound(Darr())
  Darr(i, 1) = i
Next i
Range("B5").Resize(UBound(Darr)) = Darr
Application.ScreenUpdating = True
Set WB = Nothing: Set Fso = Nothing:  Set ObjFoder = Nothing: Set ObjFile = Nothing:  Erase Darr
End Sub

 

[befaint]

Anh HieuCD,

Range("B5:AY10000").Clear 'sẽ xóa mất định dạng đã thiết lập, em nghĩ nên dùng ClearContents

Chỗ ghi số thứ tự có thể dùng range.DataSeries (em không nhớ nhìn thấy ở đâu)

Range("B5") = 1
Range("B5").Resize(i).DataSeries

Vào phá anh tẹo. hehe

 

[nhunguyet0103]

Cảm ơn các bác đã chỉ bảo giúp em ạ! Chúc các bác và gia đình ăn Tết, đón xuân An khang - Thịnh Vượng!

 

[befaint]

@ nhunguyet0103,

Thử file đính kèm...

 

[be_09]

Em cảm ơn bác nhiều...nhiều ạ! hướng dẫn của bác rất đúng với yêu cầu của em ạ! Nhưng em muốn hỏi thêm: Có thể viết code để tự động làm công việc của mục 3/ ở trên không ạ!
(vì khi xuất các file của các khu từ hệ thống phổ cập xóa mù chữ của Bộ GD thì tên của các sheet đó đã như vậy rồi ạ!)

Vậy sửa lại 1 tí, không cần biết trong phần mềm xuất ra với tên sheet là gì.

 

[HieuCD]

Anh HieuCD,
Range("B5:AY10000").Clear 'sẽ xóa mất định dạng đã thiết lập, em nghĩ nên dùng ClearContents
Chỗ ghi số thứ tự có thể dùng range.DataSeries (em không nhớ nhìn thấy ở đâu)

Range("B5") = 1
Range("B5").Resize(i).DataSeries

Vào phá anh tẹo. hehe

cám ơn bạn, code của bạn quá chuẩn, các Function rất hay, mình đã lưu vào thư viện riêng sau nầy sử dụng. Chúc bạn ngũ ngon

 

[nhunguyet0103]

bạn chạy thử code

Option Explicit
Sub TongHop()
Dim WB As Workbook, Fso As Object, ObjFoder As Object, ObjFile As Object, Darr(), i As Long
Range("B5:AY10000").Clear
Application.ScreenUpdating = False
Set Fso = CreateObject("Scripting.FileSystemObject")
Set ObjFoder = Fso.GetFolder(ThisWorkbook.Path)
For Each ObjFile In ObjFoder.Files
  If ObjFile.Name <> ThisWorkbook.Name And Fso.GetExtensionName(ObjFile) Like "xls*" Then
    Set WB = Workbooks.Open(ObjFile)
    Darr = Range("B5:AY" & Range("B5000").End(xlUp).Row).Value
    WB.Close False
    Range("B6500").End(xlUp).Offset(1, 0).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
    i = i + UBound(Darr)
  End If
Next
ReDim Darr(1 To i, 1 To 1)
For i = 1 To UBound(Darr())
  Darr(i, 1) = i
Next i
Range("B5").Resize(UBound(Darr)) = Darr
Application.ScreenUpdating = True
Set WB = Nothing: Set Fso = Nothing:  Set ObjFoder = Nothing: Set ObjFile = Nothing:  Erase Darr
End Sub

@ nhunguyet0103,


Thử file đính kèm...

Vậy sửa lại 1 tí, không cần biết trong phần mềm xuất ra với tên sheet là gì.

Em cảm ơn các bác ạ! Sao em không thấy nút Thanks đâu nhỉ?