Tổng hợp dữ liệu từ nhiều file excel vào 1 file

huynhphuong thcspt · 8/5/21

Nhờ các bạn trên diễn đàn chỉnh lại (xem) dùm code sau. Mình không biết lỗi ở đâu mà cứ mỗi lần copy (dữ liệu) nhiều file vào 1 file thì 2 file đầu dữ liệu copy đúng, bất đầu từ file thứ 3 trở đi thì bị bỏ trống khoảng 4 dòng trở lên rồi mới copy dữ liệu vào. Chân thành cảm ơn.
CODE NHƯ SAU (sưu tầm trên điễn đàn):
Sub GopFileExcel()
'XOA DU LIEU TRUOC KHI TH

Sheets("DATA").Select
Range("A1:AZ1").EntireColumn.Delete
'KHAI BAO TH
Dim FilesToOpen
Dim x As Integer
Dim wb As Workbook
'LENH TH
On Error GoTo ErrHandler
Application.DisplayAlerts = False 'tat canh bao
Application.ScreenUpdating = False 'tat nhay man hinh
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xls), *.xls", MultiSelect:=True, Title:="Files to Merge")

If MsgBox("Ban co muon chac tong hop du lieu dia ban khong?", vbYesNo) = vbYes Then 'canh bao tong hop dia ban

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

x = 1
While x <= UBound(FilesToOpen)
Set wb = Workbooks.Open(Filename:=FilesToOpen(x))

If x = 1 Then
wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
Else
lr = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
wb.Sheets(1).UsedRange.Offset(4).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)
End If

wb.Close False
x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True 'tat nhay man hinh
Application.DisplayAlerts = True 'tat canh bao
Set wb = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler

End If 'ket thuc canh bao tong hop dia ban
End Sub

Maika8008 · 15/5/21

huynhphuong thcspt đã viết:
Chào bạn MaiKa8008, cuối tuần chúc bạn sức khỏe và hạnh phúc. Mong bạn giúp mình thêm 1 vấn đề nữa là xuất danh sách với nhiều điều kiện. Nội dung diễn giải ở file đính kèm. chân thành cảm ơn bạn.

Chúc cuối tuần vui vẻ, đề phòng covid --=0

Maika8008 · 15/5/21

Mới chỉ lấy số liệu chép ra sheet. Một trong 2 năm sinh có số liệu thì lấy số liệu cho năm đó. Cả 2 năm đều có thì lấy từ năm #1 đến năm #2
Nếu thấy kiểu này được thì làm tiếp

huynhphuong thcspt · 15/5/21

Maika8008 đã viết:
Mới chỉ lấy số liệu chép ra sheet. Một trong 2 năm sinh có số liệu thì lấy số liệu cho năm đó. Cả 2 năm đều có thì lấy từ năm #1 đến năm #2
Nếu thấy kiểu này được thì làm tiếp

Cảm ơn nhiều nhé, làm phiền bạn nhiều quá ngại ghê. Theo phương án của bạn cũng được, bạn tiếp tục giúp dùm mình nha. Bạn nhớ xuất ra dùm mình cứ mỗi danh sách thành file riêng nhé (như xuất danh sách lớp vậy). Thân chào bạn.

Maika8008 · 15/5/21

huynhphuong thcspt đã viết:
Cảm ơn nhiều nhé, làm phiền bạn nhiều quá ngại ghê. Theo phương án của bạn cũng được, bạn tiếp tục giúp dùm mình nha. Bạn nhớ xuất ra dùm mình cứ mỗi danh sách thành file riêng nhé (như xuất danh sách lớp vậy). Thân chào bạn.

Chẳng thấy like yếu like mạnh gì cả à?

P/S: Post xong thấy cái like yếu

huynhphuong thcspt · 15/5/21

Maika8008 đã viết:
Chẳng thấy like yếu like mạnh gì cả à?

P/S: Post xong thấy cái like yếu

Like yếu like mạnh là sao bạn, mình không hiểu bạn chỉ thêm bài viết nào của bạn là mình bấm vào chữ thích mà.

Maika8008 · 15/5/21

Maika8008 đã viết:
Chẳng thấy like yếu like mạnh gì cả à?

P/S: Post xong thấy cái like yếu

Xong!
Làm gì thì làm chứ 3 sheet đầu không được xóa nhé!

Chỗ 2 ô năm sinh không nhất thiết ô nào có năm lớn hơn, hễ cứ có dữ liệu cho 2 ô là chạy. Tuy nhiên chưa có bẫy lỗi, nếu nhập chênh lệch 2 năm xa quá (VD: 04 và 2005) là code chạy mệt nghỉ luôn á.

Bài đã được tự động gộp: 15/5/21

Like mạnh là cái này nè

= 2 x

huynhphuong thcspt · 15/5/21

Maika8008 đã viết:
Xong!
Làm gì thì làm chứ 3 sheet đầu không được xóa nhé!

Chỗ 2 ô năm sinh không nhất thiết ô nào có năm lớn hơn, hễ cứ có dữ liệu cho 2 ô là chạy. Tuy nhiên chưa có bẫy lỗi, nếu nhập chênh lệch 2 năm xa quá (VD: 04 và 2005) là code chạy mệt nghỉ luôn á.

Bài đã được tự động gộp: 15/5/21

Like mạnh là cái này nè View attachment 258700 = 2 x View attachment 258701

Buổi tối vui vẻ nhé! Cảm ơn bạn nhiều. Điều quan trọng là làm sao like mạnh nè thật tình mình không biết luôn.

Bài đã được tự động gộp: 15/5/21

Like mạnh nè View attachment 258700 = 2 x View attachment 258701

Maika8008 · 15/5/21

huynhphuong thcspt đã viết:
Buổi tối vui vẻ nhé! Cảm ơn bạn nhiều. Điều quan trọng là làm sao like mạnh nè thật tình mình không biết luôn.

Bài đã được tự động gộp: 15/5/21

Like mạnh nè View attachment 258700 = 2 x View attachment 258701

Bạn có dùng FB không? Nếu có thì tôi khỏi nói thêm vì nó đâu khác gì lựa chọn giữa like và haha, hoặc love.

Mà làm chi có chuyện bạn không biết FB!

huynhphuong thcspt · 15/5/21

Maika8008 đã viết:
Bạn có dùng FB không? Nếu có thì tôi khỏi nói thêm vì nó đâu khác gì lựa chọn giữa like và haha, hoặc love.

Mà làm chi có chuyện bạn không biết FB!

Mình có dùng FB nhưng chì mở FB xem tin tức ít khi để ý like và haha hoặc love.
Còn trên diễn đàn này mình thấy 3 lựa chọn: Thích +trích dẫn trả lời , mình cứ nghĩ là chọn thích có nghĩa là like ( thật tình không biết like yếu lai mạnh ở đâu luôn).
Cho mình xin lỗi nhé, hứa sẽ cố gắng tìm hiểu chuyện này.
Mình đã chạy thử chương trình nó bị lỗi ở dòng tiêu đề " DANH SÁCH ĐỐI TƯỢNG PHỔ CẬP THCS SINH NĂM...." bị nhằm ở "THCS " danh sách nào cũng hiện " THCS" hết. Mình có chèn thêm code trong sub Chon() như sau để cho tiêu đề phù hợp danh sách. Mong bạn chỉ dẫn thêm.

Sub Chon()
Application.ScreenUpdating = False
If (Sheet2.Range("D12") = "MN") Then
Sheet3.Range("A3") = Sheet3.Range("A3")
End If
If (Sheet2.Range("D12") = "TH") Then
Sheet3.Range("A3") = Sheet3.Range("K3")
End If
If (Sheet2.Range("D12") = "THCS") Then
Sheet3.Range("A3") = Sheet3.Range("K4")
End If
If (Sheet2.Range("D12") = "THPT") Then
Sheet3.Range("A3") = Sheet3.Range("K5")
End If
............

Maika8008 · 15/5/21

Sửa mù trên điện thoại vì không thấy code.
Chỗ .Range("A3") = Left(...)
Sửa thành Left(.Range("A3"), số cũ trừ đi 5) & BacTN & " " & NamS

VetMini · 15/5/21

Maika8008 đã viết:
Sửa mù trên điện thoại vì không thấy code.
Chỗ .Range("A3") = Left(...)
Sửa thành Left(.Range("A3"), số cũ trừ đi 5) & BacTN & " " & NamS

Không phải do code đâu. Thớt bị lỗi thiết kế dữ liệu. Tự dưng chứa dữ liệu trong cái ô cần thay đổi.
If (Sheet2.Range("D12") = "MN") Then
Sheet3.Range("A3") = Sheet3.Range("A3")
End If
...
If (Sheet2.Range("D12") = "THCS") Then
Sheet3.Range("A3") = Sheet3.Range("K4")
End If

Khi THCS thì nó chép cái câu THCS qua A3.
Khi MN thì cái câu MN đã bị chép đè mất đất rồi.

Chú: file gì nhìn vào màu mè còn hơn gánh hát cải lương, rối cả mắt.
Sheet dùng lấy và ghi dữ liệu mà còn merge cells nữa. Giỡn mặt với tử thần.

Maika8008 · 16/5/21

Câu tôi viết là để sửa cho code của tôi trong bài #26. Hy vọng là thớt biết để tự đưa được vào đúng chỗ.

Đa số người bây giờ lạm dụng định dạng cell, nhưng theo thời gian nếu biết quản lý dữ liệu thì sẽ dần dần thay đổi cho phù hợp.

huynhphuong thcspt · 16/5/21

Maika8008 đã viết:
Sửa mù trên điện thoại vì không thấy code.
Chỗ .Range("A3") = Left(...)
Sửa thành Left(.Range("A3"), số cũ trừ đi 5) & BacTN & " " & NamS

Cảm ơn bạn đã hướng dẫn!
Mình sửa lại phần tiêu đề ở sheet (Mauln) thành DANH SÁCH ĐỐI TƯỢNG PHỔ CẬP TN.
Thay code như sau cho gọn: nws.Range("A3") = Sheet3.Range("A3") & " " & BacTN & " " & "SINH" & " " & NamS. Chương trình chạy rất tốt khớp với tiêu đề.
Đây là file dữ liệu quản lý đối tượng phổ cập giáo dục, xóa mù chữ, mình chỉ đơn cử lấy 1 thôn với số liệu nhỏ nhất, thực tế trong 1 địa phương có rất nhiều thôn, xóm (địa bàn).
Như vậy file dữ liệu đầy đủ của 1 địa phương lên tới mấy chục ngàn dòng, trích xuất rất nhiều danh sách, thống kê rất nhiều biểu mẫu. Sau này cần sự giúp đỡ của bạn nhiều. Cuối tuần chúc bạn vui vẻ, hạnh phúc. Thân chào.

huynhphuong thcspt · 22/5/21

Chào bạn Maika8008 ! Do khả năng mình có hạn nên hôm nay lại làm phiền bạn 1 lần nữa nè. Vấn đề cần giúp đã diễn giải trong file đính kèm. Xin chân thành cảm ơn.

Maika8008 · 22/5/21

Haha. Chắc khó có điểm dừng lắm he. Khuya rồi, nghỉ đã.

Maika8008 · 23/5/21

Bạn dùng thử file!

huynhphuong thcspt · 23/5/21

Maika8008 đã viết:
Bạn dùng thử file!

Quá tuyệt vời luôn bạn ơi, chương trình chạy rất tốt. Mình thích nhất là code ( arrKQ(j, 7) = "'" & arr(i, 18) 'lop ) gọn và thông minh. Cảm ơn, Chúc cuối tuần sức khỏa và hạnh phúc.

Maika8008 · 23/5/21

huynhphuong thcspt đã viết:
Quá tuyệt vời luôn bạn ơi, chương trình chạy rất tốt. Mình thích nhất là code ( arrKQ(j, 7) = "'" & arr(i, 18) 'lop ) gọn và thông minh. Cảm ơn, Chúc cuối tuần sức khỏa và hạnh phúc.

Không có chi. Chúc bạn vui vẻ!

huynhphuong thcspt · 26/5/21

Maika8008 đã viết:
Không có chi. Chúc bạn vui vẻ!

Hi! Maika8008. Gần 1 tháng nay mình học hỏi từ kiến thức vba của bạn mới được 10% à, chưa đủ công lực để giải quyết công việc của mình. Rất mong bạn chỉ dẫn thêm ( nội dung mô tả có trong file đính kèm á). Xin chân thành cảm ơn.

Thư Sinh Áo Trắng · 26/5/21

Maika8008 đã viết:
Ngó vậy chứ hết hơi à! Tôi làm từ đầu chứ không sửa sang chi.

Ké anh Thớt tý.
Bác @Maika8008 em có code lấy dữ liệu từ file đang đóng sang file đang mở(em xin của bác @buiquangthuan). Mỗi khi chạy code thì yêu cầu phải pick chọn file. Có các nào đổi lệnh pick chọn file thành đường dẫn cố định được không ạ! (file mở và file đang đóng cùng một Folder). Em cảm ơn bác!

PHP:

Sub lay_data_file_dong_sang_file_mo()
  Dim cn As Object, rs As Object
  Dim eRow&, includeList$, excludeList$, Sql$
  With Sheet1
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then .Range("A2:C" & eRow).Clear
  End With
 With Application.FileDialog(msoFileDialogFilePicker) '<--------- chỗ này chỉnh thành đường dẫn cố định được không ạ?
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count < 1 Then MsgBox ("Ban khong chon file nao"): Exit Sub
    If .SelectedItems.Count Then
 
      On Error Resume Next
      Set cn = CreateObject("adodb.connection")
      cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(1) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
      Sql = "SELECT * FROM [$A2:C] WHERE f1 is not Null"
      Set rs = cn.Execute(Sql)
      If Not rs.EOF Then Sheet1.Range("A2").CopyFromRecordset rs
      rs.Close:      cn.Close
      Set rs = Nothing: Set cn = Nothing
      On Error GoTo 0
    End If
  End With
End Sub

Ví dụ cho 2 file đính kèm vào ổ D trong Folder tên là GPE: D/GPE

Tổng hợp dữ liệu từ nhiều file excel vào 1 file

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên gạo cội

Ăn cùng góc phố

Thành viên gạo cội

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên hoạt động

File đính kèm

Facebook

Group