Lấy Dữ Liệu Từ Nhiều File Excel

Tổng phù hợp dữ liệu từ nhiều file excel vào 1 file không bắt buộc mở file​

Bài toán đặt ra như sau: Mình dịp nào cũng sẽ có 5 file dữ liệu (mỗi file khoảng 2000-5000 mẫu dữ liệu), tải về trực tiếp mỗi ngày từ server với định dạng định sẵn dưới format .xls (số cột với vị trí cột định sẵn theo chủng loại đính kèm là những file CA1, CA2, CA3, CA4, CA5). Mình cần tổng vừa lòng lại 5 file vào 1 file độc nhất (như mẫu mã đính kèm) trong những số đó du liệu của những file CA1, CA2, CA3, CA4, CA5 sẽ thông liền nhau ghep vào 1 sheet theo đúng cột tương ứng. Để tổng hợp đc mà k đề xuất mở cả 5 tệp tin lên là tốt nhất có thể (như dạng hình paste links và có linh external data vậy).Bài toán bên trên chỉ là một trong những nhu cầu của đa số người về việc làm nỗ lực nào nhằm tổng vừa lòng dữ liệu từ rất nhiều file Excel khác nhau vào phổ biến một file.

Bạn đang xem: Lấy dữ liệu từ nhiều file excel

*
"title=""width="" height="" loading="lazy" />

Xem thêm: Top 10 Phim Trường Chụp Ảnh Cưới Đẹp Hàng Đầu Tại Hà Nội (Đẹp Ngất

Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _ ByVal HasTitle As Boolean, ByVal UseTitle As Boolean) Dim rsCon As Object, rsData As Object, cat As Object, tbl As Object Dim tmpArr, Arr() Dim szConnect As String, szSQL As String, tmp As String Dim lCount As Long, lR As Long, lC As Long, lVer As Long lVer = Val(Application.Version) mix rsCon = CreateObject("ADODB.Connection") mix rsData = CreateObject("ADODB.Recordset") Set cat = CreateObject("ADOX.Catalog") If lVer "$" Then SheetName = SheetName & "$" rsCon.Open szConnect cat.ActiveConnection = rsCon szSQL = "SELECT * FROM <" và SheetName và RangeAddress & ">;" rsData.Open szSQL, rsCon, 0, 1, 1 tmpArr = rsData.GetRows ReDim Arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1) + 1) If UseTitle Then For lC = LBound(tmpArr, 1) to lớn UBound(tmpArr, 1) Arr(0, lC) = rsData.Fields(lC).Name Next end If For lR = LBound(tmpArr, 2) to UBound(tmpArr, 2) For lC = LBound(tmpArr, 1) khổng lồ UBound(tmpArr, 1) Arr(lR - UseTitle, lC) = tmpArr(lC, lR) Next Next rsData.Close: mix rsData = Nothing rsCon.Close: mix rsCon = Nothing GetData = ArrEnd FunctionSub Main() Dim vFile, FileItem, aRes, Target As Range Dim FileName As String, SheetName As String, RangeAddress As String On Error Resume Next vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsx; *.xlsm", , , , True) If TypeName(vFile) = "Variant()" Then SheetName = "Sheet1": RangeAddress = "A8:V10000" For Each FileItem In vFile FileName = CStr(FileItem) If UCase(FileName) UCase(ThisWorkbook.FullName) Then aRes = GetData(FileName, SheetName, RangeAddress, False, False) If IsArray(aRes) Then phối Target = Sheet1.Range("A60000").End(xlUp).Offset(1) Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes end If end If Next MsgBox "Done!" over IfEnd Sub
Cách dùng:- mang đến code trên vào Module- Chạy sub Main- cửa sổ open File hiện nay ra, sử dụng chuột chọn file đầu, bấm giữ phím Shift rồi còn tệp tin cuối ---> Bấm nút Open- hóng trong giây lát, lúc MsgBox hiện ra thông báo hoàn tất, kiểm tra lại tài liệu trong tệp tin hiện hành coi đã cập nhật chưa-------------Lưu ý: tệp tin TongHop cần được lưu lại theo định dạng XLSM (nếu lưu bởi XLSX vẫn mất sạch mát code). Xung quanh ra, chúng ta cũng lưu ý đoạn tô đậm A8:V10000 sơn đậm trên thiết yếu là địa chỉ cửa hàng lấy dữ liệu. Nếu dữ liệu của bạn bước đầu từ A2 đến F100 chẳng hạn, chúng ta có thể sửa thành A2:F100 để đảm bảo sự chủ yếu xác.Chúc bạn thành công!Một số bài viết có liên quan:1/ Làm cách nào nhằm ghi chú công dụng trong VBA?2/ Conditional Formatting mang lại biểu đồ bởi VBA3/ lúc nào nên áp dụng Msgbox, Inputbox và Userform?4/ 8 mẹo nhỏ trong VBE chúng ta nên biết5/ Kích hoạt macro từ bỏ nút bấm ngoại trừ bảng tính6/ Làm nỗ lực nào để thay thế các chữ OK, CANCEL,... Nhàm chán của Msgbox7/ ra mắt VBA vào Excel8/ Viết code để xem thấy ai là người cập nhật bảng tính của người sử dụng lần cách đây không lâu nhất9/ 4 cách sử dụng Immediate Window trong VBA công dụng hơn10/ 3 gợi ý nhỏ mang lại thành công trong khai báo trở nên trong VBA