Tổng hợp dữ liệu từ nhiều file excel vào 1 file không cần mở file

Quảng cáo

Tổng hợp dữ liệu từ nhiều file excel vào 1 file không cần mở file​


Bài toán đặt ra như sau:

Mình lúc nào cũng sẽ có 5 file dữ liệu (mỗi file khoảng 2000-5000 dòng dữ liệu), download trực tiếp hàng ngày từ server với định dạng định sẵn dưới định dạng .xls (số cột và vị trí cột định sẵn theo mẫu đính kèm là các file CA1, CA2, CA3, CA4, CA5). Mình cần tổng hợp lại 5 file vào 1 file duy nhất (như mẫu đính kèm) trong đó du liệu của các file CA1, CA2, CA3, CA4, CA5 sẽ nối tiếp nhau ghep vào 1 sheet theo đúng cột tương ứng. Để tổng hợp đc mà k cần mở cả 5 file lên là tốt nhất (như kiểu paste link và có linh external data vậy).

Bài toán trên chỉ là một trong những nhu cầu của rất nhiều người về việc làm thế nào để tổng hợp dữ liệu từ nhiều file Excel khác nhau vào chung một file.

32387587165_4ffaa22514_o.png[SIZE=3][SIZE=2]


Để làm được điều này, bạn hãy sử dụng đoạn code sau.

Mã:
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)
  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  Set cat = CreateObject("ADOX.Catalog")

  If lVer < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  End If
  If SheetName = "" Then
    Dim Dbs  As Object, db As Object
    Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVer < 12, "36", "120"))
    Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
    tmp = db.TableDefs(0).Name
    tmp = Replace(tmp, " ", "?")
    tmp = Replace(tmp, "'", " ")
    tmp = WorksheetFunction.Trim(tmp)
    tmp = Replace(tmp, " ", "'")
    tmp = Replace(tmp, "?", " ")
    SheetName = tmp
    db.Close
    Set Dbs = Nothing: Set db = Nothing
  End If
  If Right(SheetName, 1) <> "$" Then SheetName = SheetName & "$"
  rsCon.Open szConnect
  cat.ActiveConnection = rsCon

  szSQL = "SELECT * FROM [" & SheetName & 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 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) To UBound(tmpArr, 1)
      Arr(lR - UseTitle, lC) = tmpArr(lC, lR)
    Next
  Next
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  GetData = Arr
End Function

Sub 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 = "[B]A8:V10000[/B]"
    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
          Set 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!"
  End If
End Sub

Cách dùng:
- Cho code trên vào Module
- Chạy sub Main
- Cửa sổ Open File hiện ra, dùng chuột chọn file đầu, bấm giữ phím Shift rồi còn file cuối ---> Bấm nút Open
- Chờ trong giây lát, khi MsgBox hiện ra báo hiệu hoàn tất, kiểm tra lại dữ liệu trong file hiện hành xem đã cập nhật chưa
-------------
Lưu ý: File TongHop phải được lưu theo định dạng XLSM (nếu lưu bằng XLSX sẽ mất sạch code). Ngoài ra, bạn cũng lưu ý đoạn tô đậm A8:V10000 tô đậm trên chính là địa chỉ lấy dữ liệu. Nếu dữ liệu của bạn bắt đầu từ A2 đến F100 chẳng hạn, bạn có thể sửa thành A2:F100 để bảo đảm sự chính 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 để ghi chú hiệu quả trong VBA?
2/ Conditional Formatting cho biểu đồ bằng VBA
3/ Khi nào nên sử dụng Msgbox, Inputbox và Userform?
4/ 8 thủ thuật trong VBE bạn nên biết
5/ Kích hoạt macro từ nút bấm ngoài bảng tính
6/ Làm thế nào để thay thế các chữ OK, CANCEL,... nhàm chán của Msgbox
7/ Giới thiệu VBA trong Excel
8/ Viết code để nhìn thấy ai là người cập nhật bảng tính của bạn lần gần đây nhất
9/ 4 cách sử dụng Immediate Window trong VBA hiệu quả hơn
10/ 3 gợi ý nhỏ mang lại thành công trong khai báo biến trong VBA
 

File đính kèm

  • tong hop du lieu vao 1 file.rar
    51.2 KB · Đọc: 105
Chỉnh sửa lần cuối bởi điều hành viên:
Mình đã download file mẫu và làm thành công. Mình có câu hỏi này, mong các bác pro chỉ giáo

Tình hình là trong quá trình mình dùng, các file excel cần nối thì tên sheet phải là sheet1 thì mới nối được. Nhưng các file excel mình down trên hệ thống cty của mình về thì lại tên là "Report". Nếu muốn dùng thì phải vào từng file excel, sửa tên "Report" thành "Sheet1" thì mới dùng được file mẫu ở trên.

Mình cũng đã lục trong VBA, đổi chỗ nào có "Sheet1" thành chữ "Report" nhưng file mẫu lại không chạy được. Báo lỗi "Definded ..." (mình không nhớ rõ lắm).

Có cách nào không để tên là "Sheet1" mà vẫn dùng được file mẫu để nối các file không các bạn?

Thanks
 
#21
Mã:
Sub T1()
MsgBox Sheets("Report").[COLOR=#ff0000]CodeName[/COLOR]
End Sub
'----------
Sub T2()
MsgBox Sheets("Report").[COLOR=#ff0000]Name[/COLOR]
End Sub
 
#21
Mã:
Sub T1()
MsgBox Sheets("Report").[COLOR=#ff0000]CodeName[/COLOR]
End Sub
'----------
Sub T2()
MsgBox Sheets("Report").[COLOR=#ff0000]Name[/COLOR]
End Sub

Bạn ơi, bạn có thể hướng dẫn kỹ hơn xíu cách dùng code trên giúp mình với. Mình nên bỏ đoạn code trên ở đâu trong VBA.
Chữ bạn tô đỏ có cần phải thay thế gì không? Hay giữ nguyên
Thanks bạn
 
Chào anh ndu96081631
Sau khi thử em thấy file tổng hợp thì không có liên kết công thức như file gốc( ví dụ file gốc có công thức thì file tổng hợp cũng có công thức thì có được không).
Ví dụ file CA4 có công thức ở cột B8 đến B12 thì file tổng hợp cũng có công thức đó thì làm thể nào anh.
Cám ơn
 

File đính kèm

  • CA4.xlsx
    9 KB · Đọc: 6
Thân chào các anh !
em thấy code rất tốt rồi nhưng theo yêu cầu công việc của em là dữ lieu lấy vào không liên tục trong một sheet như C7, D20, N8, P14, ... (định dạng Form của sheet là giống nhau). Như vậy thì code phải sửa lại như thế nào vậy các anh?
em rất mong được anh ndu96081631, anh befaint giúp cho .
em xin chân thành cảm ơn !
Trân trọng,
 
Dạ, vâng. Em nhầm ạ. Nếu mình tổng hợp vài chục file (khoảng 50 File) thì code có thay đổi gì không thầy.

Cái này bạn nên đăng bài mới, nêu vấn đề cụ thể và đính kèm vài File mẫu để biết cấu trúc File như thế nào, chứ không đơn thuần là cứ chọn File là nó tổng hợp vào hết, lúc đó tìm cái si thì không biết đâu mà lần (muốn giải quyết vấn đề gì thì phải nắm cái gốc trước, sau đó mới giải quyết phần ngọn)
 
Kính gửi Tác giả,
Em có trường hợp, khi đổ số liệu từ phần mềm thì tên sheet là tên tiếng việt. Do vậy khi import bằng đoạn code trên thì ko đc. Phải đổi tên sheet là sheet1 thì mới copy đc. Vậy để khắc phụ điều này thì cần phải sửa lại code ở đâu ạ?
Rất mong tác giả và các anh chị trên diễn đàn giúp đỡ em.
Em xin chân thành cảm ơn!
 
Mình có câu hỏi này mong các bác chỉ giáo. Mình có 2 sheet có số dòng cột sắp xếp y như nhau, chỉ khác công thức trong ừng sheet ạ.

Các bác có cách nào mà khi em thêm dòng ở sheet1 thì sheet2 sẽ tự động chèn thêm dòng vào không ạ.

Thanks các bác trước
 
Cảm ơn bạn. Bạn nên thêm các chú thích với các dòng lệnh để mọi người có thể hiểu rõ hơn ý nghĩa của nó, và có thể phát triển những ứng dụng khác.
 
Thầy ndu96081631 ơi với những file có đuôi .csv thì có làm đc không ạ, mong thầy chỉ giúp em với.
Cảm ơn thầy nhiều!
 

File đính kèm

  • New Folder.rar
    3 KB · Đọc: 4
Lần chỉnh sửa cuối:
Do Công ty mình đang muốn thương mại hóa các phần mềm Excel của công ty, nên mình không thể chia sẽ code cho các bạn được. Nhưng để tổng hợp dữ liệu Excel qua mạng ( hoặc trong mạng LAN ), mình có góp ý như sau để các bạn tham khảo:
1/ Bạn nên xuất dữ liệu từ các file Excel nguồn ra file .txt .Lợi ích của file .txt không chỉ dùng trong Excel ( vì nó là họ hàng của Excel ) mà nó còn có thể dùng cho SQL nếu cần
2/ Khi dữ liệu đã là file .txt rồi thì bạn có thể upload lên mạng vào file tổng, sau đó download file tổng về máy và import vào file Excel hoặc upload lên mạng thành từng file dữ liệu riêng lẻ, sau đó down load các file về máy rồi tổng hợp thành một file tổng sau đó import vào file Excel. Mỗi một cách có ưu và khuyết điểm riêng.
3/ Trong quá trình download thì nó kiểm tra có file mới thì down, nều không thì thôi.
Trên Excel 2003 có thể làm được việc này rồi.
Chúc các bạn thành công.
 
Chào thầy ndu96081631,

Mình có thể viết câu lệnh để chương trình tự động mở những file cố định mà không phải hiện cửa sổ open không vậy thầy?
Em đang ứng dụng code của thầy để lấy dữ liệu từ 4 máy dập về 1 file tổng hợp để vẽ biểu đồ. Dữ liệu được tự động cập nhật sau mỗi 15 giây.
Kinh nhờ thầy giúp đỡ.
Em cảm ơn.
 
Quảng cáo
Top Bottom