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

Liên hệ QC

ffcb1900

Thành viên chính thức
Tham gia
27/7/08
Bài viết
77
Được thích
4
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).

Mong mọi người giúp đỡ với
 

File đính kèm

  • tong hop du lieu vao 1 file.zip
    35.1 KB · Đọc: 951
Chào Thầy và các anh chi !
Em muốn
tổng hợp du lieu từ tất cả các sheet trong nhiều file vào một sheet tổng hợp. vậy code này phải sửa như thế nào?
nhờ
Thầy và các anh chi giúp.

Xinh chân thành cảm ơn !!
code này nhìn quen quen--=0--=0
vui lòng xem file
chú ý tên sheet trong file nguồn sủa thành sheet1,2,3...thì mới chạy
 

File đính kèm

  • tong hop bao cao.rar
    728.6 KB · Đọc: 225
Upvote 0
Mọi người ơi giúp em với :)
gửi bài viết tháng 8 rồi tháng 10 quay lại , rồi sau hôm nay thì tháng mấy bạn quay lại ?
muốn sửa code thì xóa hết code đang có trong file rồi ghi code này vào mà chạy
Mã:
Public Sub hello()
Dim cn As Object, cat As Object, filename, sheetname As String, tbl As Object, vFile
On Error Resume Next
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
vFile = Application.GetOpenFilename("Excel File, *.xl*", , , , True)
If TypeName(vFile) = "Variant()" Then
    For Each filename In vFile
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";mode=read;Extended Properties=""Excel 12.0;HDR=no"";"
        Set cat.ActiveConnection = cn
        For Each tbl In cat.tables
            If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
                sheetname = " [" & Replace(tbl.Name, "'", "") & "A13:EM13]"
                'error when range [A13:EM13] empty
                Sheet1.Range("B100000").End(xlUp).Offset(1) _
                .CopyFromRecordset cn.Execute("select * from " & sheetname)
            End If
        Next
        cn.Close
    Next
End If
End Sub
 
Upvote 0
Em xin kính chào cả nhà,
Em đã đọc hết 7 trang của Thread này – nhưng thực sự chưa thấy có nội dung nào như nội dung em cần thực hiện sau đây để áp dụng – nên em đành mạo muội viết post này và các thông tin attach, xin kính nhờ cả nhà giúp em với:
– Em có 1 file tổng hợp – tên gọi AToZ_Summary.xls → Lưu ở 1 Folder riêng
– Và các file chi tiết (cụ thể em attach ở đây là 8 file) → các file này lưu CHUNG ở 1 Folder riêng (không giống folder của File Summary nêu trên)


Em cần tổng hợp số liệu từ 1 sheet của các File Chi tiết này vào File Summary như em ghi nhận Yêu cầu trong File Summary. Xin nói rõ là các File chi tiết sẽ có nhiều Sheet, không chỉ Sheet cần lấy thông tin (Sheet cần thông tin này có mã hiệu ABC) – nhưng em chỉ quan tâm cái Sheet cần lấy thông tin này mà thôi – các Sheet còn lại thì không sử dụng vào file Summary.


Em zip toàn bộ các File này vào chung 1 folder để cả nhà dễ hình dung.


Vậy em kính nhờ cả nhà giúp em với ạ – nội dung em thỉnh nhờ cả nhà là em đã ghi nhận trong Sheet "AToZ_Summary" của File AToZ_Summary.xls rồi ạ


Em rất cảm ơn cả nhà đã đọc tin và em mong tin cả nhà lắm ạ
Em chuotpt3
 

File đính kèm

  • AToZ.rar
    66.3 KB · Đọc: 59
Upvote 0
Em Kính mong cả nhà giúp em với ạ ......

Em xin chân thành cảm ơn cả nhà!!
Em
Chuotpt3
 
Upvote 0
Em xin kính chào cả nhà,
Em đã đọc hết 7 trang của Thread này – nhưng thực sự chưa thấy có nội dung nào như nội dung em cần thực hiện sau đây để áp dụng – nên em đành mạo muội viết post này và các thông tin attach, xin kính nhờ cả nhà giúp em với:
– Em có 1 file tổng hợp – tên gọi AToZ_Summary.xls → Lưu ở 1 Folder riêng
– Và các file chi tiết (cụ thể em attach ở đây là 8 file) → các file này lưu CHUNG ở 1 Folder riêng (không giống folder của File Summary nêu trên)


Em cần tổng hợp số liệu từ 1 sheet của các File Chi tiết này vào File Summary như em ghi nhận Yêu cầu trong File Summary. Xin nói rõ là các File chi tiết sẽ có nhiều Sheet, không chỉ Sheet cần lấy thông tin (Sheet cần thông tin này có mã hiệu ABC) – nhưng em chỉ quan tâm cái Sheet cần lấy thông tin này mà thôi – các Sheet còn lại thì không sử dụng vào file Summary.


Em zip toàn bộ các File này vào chung 1 folder để cả nhà dễ hình dung.


Vậy em kính nhờ cả nhà giúp em với ạ – nội dung em thỉnh nhờ cả nhà là em đã ghi nhận trong Sheet "AToZ_Summary" của File AToZ_Summary.xls rồi ạ


Em rất cảm ơn cả nhà đã đọc tin và em mong tin cả nhà lắm ạ
Em chuotpt3

1. Lúc thì "Đủ Điều kiện", lúc thì "Đủ đk" ??? Đã xây dựng dữ liệu mà không chuẩn thì có bằng không ah? --> Viết code cũng vất vả...tốn công

2. Bài này mà bạn dùng ADO chi cho mệt vậy???

3. Chạy code sau,-> Của sổ mở File xuất hiện -> Multi Select File (chọn 1 lần nhiều file) muốn lấy dữ liệu vào...và hưởng kết quả.

Mã:
Option Explicit


Public Sub GPE()
Dim X As Variant, Y As Long, vFile As String, Wb As Workbook, Sh As Worksheet, tSheet As String
Dim sArr, dArr, I As Long, Dk As String, Dk1 As String, Dx As String, Dt As String
Dim UGD As Currency, XHD As Currency, DTH As Currency
Dk = ChrW(272) & ChrW(7911) & " " & ChrW(272) & "i" & ChrW(7873) & "u ki" & ChrW(7879) & "n"
Dk1 = ChrW(272) & ChrW(7911) & " " & ChrW(273) & "k"
Dx = ChrW(272) & "ã xu" & ChrW(7845) & "t"
Dt = ChrW(272) & "ã thu"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
X = Application.GetOpenFilename(, , , , True)
ReDim dArr(1 To UBound(X), 1 To 12)
If Not IsArray(X) Then Exit Sub
For Y = 1 To UBound(X)
vFile = Replace(X(Y), "\", "", InStrRev(X(Y), "\"))
tSheet = Left(vFile, InStr(1, vFile, "_Ch") - 1)
    Set Wb = Workbooks.Open(X(Y))
    Set Sh = Wb.Sheets(tSheet)
        dArr(Y, 1) = Y: dArr(Y, 2) = Sh.[C2]: dArr(Y, 3) = Sh.[E2]
        dArr(Y, 4) = Sh.[G2]: dArr(Y, 5) = Sh.[J2]
        dArr(Y, 6) = Sh.[C3]: dArr(Y, 7) = Sh.[E3]: dArr(Y, 8) = Sh.[G3]: dArr(Y, 9) = Sh.[I3]
    sArr = Sh.Range("A13").CurrentRegion.Value
    UGD = 0: XHD = 0: DTH = 0
        For I = 2 To UBound(sArr)
            If sArr(I, 2) <> Empty Then
                If sArr(I, 6) = Dk Or sArr(I, 6) = Dk1 Then UGD = UGD + sArr(I, 5)
                If sArr(I, 7) = Dx Then XHD = XHD + sArr(I, 3)
                If sArr(I, 10) = Dt Then DTH = DTH + sArr(I, 3)
            End If
        Next I
        dArr(Y, 10) = UGD: dArr(Y, 11) = XHD: dArr(Y, 12) = DTH
    Wb.Close False
Next Y
    Range("A5").Resize(10, 12).ClearContents
    Range("A5").Resize(Y - 1, 12).Value = dArr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Dạ, em xin lỗi vì không check lại dữ liệu
Em xin cảm ơn anh/thầy hpkhuong lắm lắm – để em chạy thử xem ạ ......
}}}}}}}}}}}}}}}}}}}}}}}}}
 
Upvote 0
Em xin kính chào Thầy hpkhuong,
Code này chạy thì đúng ạ, không có sai và đúng như em ghi nhận yêu cầu bên trên. Em cảm ơn Thầy lắm.

Nhưng xin Thầy cho em hỏi chút và kính nhờ Thầy ạ:
– Hiện tại các File lẻ AAA, BBB, ...... cần lấy số liệu này là em giả lập số để thông tin rõ ràng hơn chút – và các file này không chỉ có Sheet mà Thầy đã giúp lấy số liệu ấy, mà còn có các Sheet khác nữa – vậy khi chạy code này để lấy số liệu từ Sheet như Sheet em giả lập ấy, thì em ghi nhận TÊN GỌI Sheet này nhận dạng là Mã ABC thì code này chạy có đúng nữa không ạ?
– Và em cũng mong Thầy giúp em thiết kế 1 Button để chạy khi tổng hợp số liệu mà không phải vào ADO code chạy như hiện tại được không Thầy ơi?

Em Mong tin Thầy lắm ạ
Em
chuotpt3
 
Upvote 0
Xin chào các anh chị trên diễn đàn
Ở bài #3 Thầy ndu có tạo một hàm và sub Main để tổng hợp nhiều file excel vào 1 file nhưng thí dụ có 1 file excel trống (không có số liệu hoặc chỉ có tiêu đề) thì kết quả khi chạy sẽ lấy số liệu file trước đó gán vào file trống này (ví dụ file CA1 có 4 dòng số liệu file CA6 trống nếu lấy CA1 trước CA6 thì kết quả sẽ là 8 dòng CA1)
Xin hỏi các anh chị trên diễn đàn cùng thầy ndu mình sửa code như thế nào để kết quả ra đúng
Cám ơn các anh chị rất nhiều
 
Upvote 0
Mọi người cho em hỏi, phần RangeAddress = "B3:TM500000" của em là từ B đến TM, nhưng khi chạy macro thì chỉ lấy từ B đến IU, vì sao lại như vậy ạ.

Em cảm ơn!
 
Upvote 0
Kính gửi diễn đàn giaiphapexcel.com em đã xem từ đầu đến cuối 7 trang về:Tổng hợp dữ liệu từ nhiều file excel vào 1 file không cần mở file"

nhưng em chưa tìm ra cách giải quyết vấn đề của mình rất mong diễn đàn chỉ giúp:
Vấn đề của em như sau:
- Em có 1 folder: QLCV
- Trong folder QLCV: hàng năm em tạo ra các folder theo năm như folder: 2004, 2005, 2006...
- Trong folder QLCV: em có file excel TongHopDiDen.xls dùng để tổng hợp dữ liệu từ các sheet DataDen của các file 2004.xls, 2005.xls, 2006.xls... tương ứng trong các folder: 2004,2005,2006... vào 1 sheet THDataDen.
Rất mong các Thầy trên diễn đàn giúp đỡ em. Em cám ơn rất nhiều.
Vì file gốc của em rất lớn không thể gửi lên được. Em xin gửi file mẫu giống file gốc mong mọi các thầy giúp đỡ.

[h=1]http://www.mediafire.com/file/k0out1xx5xdnz16/QLVB.rar[/h]
 
Lần chỉnh sửa cuối:
Upvote 0
Kính gửi diễn đàn giaiphapexcel.com em đã xem từ đầu đến cuối 7 trang về:Tổng hợp dữ liệu từ nhiều file excel vào 1 file không cần mở file"

nhưng em chưa tìm ra cách giải quyết vấn đề của mình rất mong diễn đàn chỉ giúp:
Vấn đề của em như sau:
- Em có 1 folder: QLCV
- Trong folder QLCV: hàng năm em tạo ra các folder theo năm như folder: 2004, 2005, 2006...
- Trong folder QLCV: em có file excel TongHopDiDen.xls dùng để tổng hợp dữ liệu từ các sheet DataDen của các file 2004.xls, 2005.xls, 2006.xls... tương ứng trong các folder: 2004,2005,2006... vào 1 sheet THDataDen.
Rất mong các Thầy trên diễn đàn giúp đỡ em. Em cám ơn rất nhiều.
Vì file gốc của em rất lớn không thể gửi lên được. Em xin gửi file mẫu giống file gốc mong mọi các thầy giúp đỡ.

http://www.mediafire.com/file/k0out1xx5xdnz16/QLVB.rar

Bạn chạy thử đoạn sau:
Mã:
Public Sub GPE_ADO()
Dim FOb As Object, Item As Object, Pth As String
Dim cn As Object, rs As Object, Ws As Worksheet
Set Ws = ThisWorkbook.Sheets("THDataDen")
Set cn = CreateObject("ADODB.Connection")
Pth = ThisWorkbook.Path
Application.ScreenUpdating = False
Ws.Range("A2").Resize(5000, 18).ClearContents
Set FOb = CreateObject("Scripting.FileSystemObject").GetFolder(Pth)
For Each Item In FOb.SubFolders
    cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & _
        Pth & "\" & Item.Name & "\" & Item.Name & ".xlsx" & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
            Set rs = cn.Execute("select * from [Den$A:R] where f1 is not null")
            If Not rs.EOF Then Ws.Range("A65000").End(3)(2).CopyFromRecordset rs
            rs.Close
            cn.Close
Next Item
Set cn = Nothing
Set FOb = Nothing
Set Item = Nothing
MsgBox "Da Tong Hop Xong!"
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Cám ơn hpkhuong rất nhiều mình đã thử và chạy rất tốt. Nhưng khi test trên excel 2003 thì bị báo lỗi ở dòng này: Set rs = cn.Execute("select * from [Den$A:R] where f1 is not null"). Rất mong hpkhuong giúp mình lần nữa
 
Upvote 0
Cám ơn hpkhuong rất nhiều mình đã thử và chạy rất tốt. Nhưng khi test trên excel 2003 thì bị báo lỗi ở dòng này: Set rs = cn.Execute("select * from [Den$A:R] where f1 is not null"). Rất mong hpkhuong giúp mình lần nữa
bạn sủa những chố sau xem
Microsoft.ACE.OLEDB.12.0

thành Microsoft.JET.OLEDB.4.0

Excel 12.0 thành Excel 8.0
 
Upvote 0
Bạn chạy thử đoạn sau:
Mã:
Public Sub GPE_ADO()
Dim FOb As Object, Item As Object, Pth As String
Dim cn As Object, rs As Object, Ws As Worksheet
Set Ws = ThisWorkbook.Sheets("THDataDen")
Set cn = CreateObject("ADODB.Connection")
Pth = ThisWorkbook.Path
Application.ScreenUpdating = False
Ws.Range("A2").Resize(5000, 18).ClearContents
Set FOb = CreateObject("Scripting.FileSystemObject").GetFolder(Pth)
For Each Item In FOb.SubFolders
    cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & _
        Pth & "\" & Item.Name & "\" & Item.Name & ".xlsx" & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
            Set rs = cn.Execute("select * from [Den$A:R] where f1 is not null")
            If Not rs.EOF Then Ws.Range("A65000").End(3)(2).CopyFromRecordset rs
            rs.Close
            cn.Close
Next Item
Set cn = Nothing
Set FOb = Nothing
Set Item = Nothing
MsgBox "Da Tong Hop Xong!"
Application.ScreenUpdating = True
End Sub

anh,
em muốn lấy dữ lieu từ các file khác nhưng dữ lieu nằm rãi rác như A13, C56, D78,...
thì mình sửa code sao anh?
em cảm ơn anh trước nhiều nhiều!
 
Upvote 0
Cám ơn hpkhuong rất nhiều mình đã thử và chạy rất tốt. Nhưng khi test trên excel 2003 thì bị báo lỗi ở dòng này: Set rs = cn.Execute("select * from [Den$A:R] where f1 is not null"). Rất mong hpkhuong giúp mình lần nữa
Rất có thể file con bên trong là 2003
Nên bạn sửa cụm sau trong code trên.
Mã:
 & ".xlsx" &

Thành
Mã:
 & ".xls" &
 
Upvote 0
Web KT
Back
Top Bottom