Tổng hợp dữ liệu từ nhiều file có điều kiện

[kokano90]

Em chào các thầy cô ạ.
Nhờ các thầy cô trên GPE giúp em việc tổng hợp dữ liệu từ nhiều file có cấu trúc giống nhau với ạ
Hiện tại em vẫn đang làm thủ công là mở từng file lên và copy dữ liệu xong rồi dán vô file tổng hợp.
Bản thân em giờ mong thầy cô giúp. khi mình Click "Lấy dữ liệu" sẽ hiện bảng thông báo chọn file. sau đó sẽ tự động lấy dữ liệu của các file đã chọn paste vào bảng tổng hợp ạ.
Cảm ơn các thầy cô nhiều ạ.

 

[snow25]

Em chào các thầy cô ạ.
Nhờ các thầy cô trên GPE giúp em việc tổng hợp dữ liệu từ nhiều file có cấu trúc giống nhau với ạ
Hiện tại em vẫn đang làm thủ công là mở từng file lên và copy dữ liệu xong rồi dán vô file tổng hợp.
Bản thân em giờ mong thầy cô giúp. khi mình Click "Lấy dữ liệu" sẽ hiện bảng thông báo chọn file. sau đó sẽ tự động lấy dữ liệu của các file đã chọn paste vào bảng tổng hợp ạ.
Cảm ơn các thầy cô nhiều ạ.

View attachment 227857

Dùng ADO.

 

[kokano90]

Dùng ADO.

Dạ. Em cũng nghĩ là dùng ADO. Trước giờ có tham khảo bài viết của các thầy cô. Do khả năng có hạn. Với lại thấy tổng hợp dữ liệu toàn xuôi xuống theo dòng. Trong khi em muốn xuôi theo cột nên chưa biết làm thế nào. Em theo dõi thấy Anh cũng giỏi VBA. Phiền anh hỗ trợ hoặc gợi ý giúp em với được không ạ. Em cảm ơn ạ

 

[HieuCD]

Em chào các thầy cô ạ.
Nhờ các thầy cô trên GPE giúp em việc tổng hợp dữ liệu từ nhiều file có cấu trúc giống nhau với ạ
Hiện tại em vẫn đang làm thủ công là mở từng file lên và copy dữ liệu xong rồi dán vô file tổng hợp.
Bản thân em giờ mong thầy cô giúp. khi mình Click "Lấy dữ liệu" sẽ hiện bảng thông báo chọn file. sau đó sẽ tự động lấy dữ liệu của các file đã chọn paste vào bảng tổng hợp ạ.
Cảm ơn các thầy cô nhiều ạ.

View attachment 227857

Thử code

Sub TongHop()
  Dim item, cn As Object, Table$, sqlStr$, sqlStr2$
  Dim i As Long, j As Long
  Set cn = CreateObject("ADODB.Connection")
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = True
    .Show
    If .SelectedItems.Count Then
      On Error Resume Next
      Table = "data$E16:E28"
      sqlStr = "Select f1 From [data$C3:C3] "
      sqlStr2 = "Select f1 From [data$E16:E28] "
      For Each item In .SelectedItems
        cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & item & ";" & "Extended Properties=""Excel 12.0;HDR=No"";")
        With Sheets("Sheet2")
          ecol = .Range("AAA3").End(xlToLeft).Column
          .Cells(3, ecol + 1).CopyFromRecordset cn.Execute(sqlStr)
          .Cells(4, ecol + 1).CopyFromRecordset cn.Execute(sqlStr2)
        End With
        cn.Close
      Next item
      Set cn = Nothing
      MsgBox "Da Tong Hop Xong!"
      On Error GoTo 0
    End If
  End With
End Sub

 

[kokano90]

Thử code

Sub TongHop()
  Dim item, cn As Object, Table$, sqlStr$, sqlStr2$
  Dim i As Long, j As Long
  Set cn = CreateObject("ADODB.Connection")
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = True
    .Show
    If .SelectedItems.Count Then
      On Error Resume Next
      Table = "data$E16:E28"
      sqlStr = "Select f1 From [data$C3:C3] "
      sqlStr2 = "Select f1 From [data$E16:E28] "
      For Each item In .SelectedItems
        cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & item & ";" & "Extended Properties=""Excel 12.0;HDR=No"";")
        With Sheets("Sheet2")
          ecol = .Range("AAA3").End(xlToLeft).Column
          .Cells(3, ecol + 1).CopyFromRecordset cn.Execute(sqlStr)
          .Cells(4, ecol + 1).CopyFromRecordset cn.Execute(sqlStr2)
        End With
        cn.Close
      Next item
      Set cn = Nothing
      MsgBox "Da Tong Hop Xong!"
      On Error GoTo 0
    End If
  End With
End Sub

Cám ơn thầy nhiều ạ. Cho em hỏi 1 thêm 1 chút ạ. Nếu ở các file con được chọn. Nó có nhiều sheet. tên sheet nó là tiếng Nhật( nhưng lúc nào nó cũng là sheet1 thì phải sửa đoạn code trên thế nào ạ

 

[HieuCD]

Cám ơn thầy nhiều ạ. Cho em hỏi 1 thêm 1 chút ạ. Nếu ở các file con được chọn. Nó có nhiều sheet. tên sheet nó là tiếng Nhật( nhưng lúc nào nó cũng là sheet1 thì phải sửa đoạn code trên thế nào ạ

Sub TongHop2()
  Dim item, wb As Workbook, sh As Worksheet
  Dim n As Long
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = True
    .Show
    If .SelectedItems.Count Then
      Application.DisplayAlerts = False
      Application.AskToUpdateLinks = False
      Application.ScreenUpdating = False
      Set sh = ThisWorkbook.Sheets("Sheet2")
      For Each item In .SelectedItems
        Set wb = Workbooks.Open(item)
        For n = 1 To wb.Sheets.Count
          If wb.Sheets(n).CodeName = "Sheet1" Then
            ecol = sh.Range("AAA3").End(xlToLeft).Column
            sh.Cells(3, ecol + 1).Value = wb.Sheets(n).Range("C3").Value
            sh.Cells(4, ecol + 1).Resize(13) = wb.Sheets(n).Range("E16:E28").Value
            Exit For
          End If
        Next n
        wb.Close False
      Next item
      Application.ScreenUpdating = True
      Application.AskToUpdateLinks = True
      Application.DisplayAlerts = True
      MsgBox "Da Tong Hop Xong!"
    End If
  End With
End Sub

 

[kokano90]

Dạ. Cám ơn thầy ạ. Để mai em test ạ. Đoạn code số 1 ấy. Em có tìm lại bài của thầy Hai lúa miền tây.chợt nhớ ra. Bỏ phần tên sheet đi là nó cứ lấy sheet 1 ạ

 

[HieuCD]

Dạ. Cám ơn thầy ạ. Để mai em test ạ. Đoạn code số 1 ấy. Em có tìm lại bài của thầy Hai lúa miền tây.chợt nhớ ra. Bỏ phần tên sheet đi là nó cứ lấy sheet 1 ạ

Cẩn thận nha, cách nầy khá phiêu lưu

 

[befaint]

Cẩn thận nha, cách nầy khá phiêu lưu

Có cách dùng ADO catalog để lấy tên sheet đó anh. Vẫn làm tiếp bài #4 được anh.

 

[HieuCD]

Có cách dùng ADO catalog để lấy tên sheet đó anh. Vẫn làm tiếp bài #4 được anh.

Nhìn lạ hoắc, Lấy lệnh trên Google chạy thử nó báo lỗi từ vòng khai báo , bạn viết code tiếp để anh em mở mang kiến thức

 

[befaint]

Nhìn lạ hoắc, Lấy lệnh trên Google chạy thử nó báo lỗi từ vòng khai báo , bạn viết code tiếp để anh em mở mang kiến thức

Có nhiều bài rồi mà anh.

 

[HieuCD]

Có nhiều bài rồi mà anh.

Hướng dẫn của Google cũng tương tự, dùng khai báo sớm máy mình báo lỗi. Tìm hết rồi, không có cách lấy CodeName

Dạ. Cám ơn thầy ạ. Để mai em test ạ. Đoạn code số 1 ấy. Em có tìm lại bài của thầy Hai lúa miền tây.chợt nhớ ra. Bỏ phần tên sheet đi là nó cứ lấy sheet 1 ạ

Dùng ô A1 lưu tên Sheet "Tiếng Nhật", bạn nhập tên sheet thực tế vào ô nầy

Sub TongHop()
  Dim item, cn As Object, shName$, sqlStr$, sqlStr2$
  Dim i As Long, j As Long
  Set cn = CreateObject("ADODB.Connection")
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = True
    .Show
    If .SelectedItems.Count Then
      On Error Resume Next
      shName = Sheets("Sheet2").Range("A1").Value 'Ten Sheet Du lieu
      sqlStr = "Select f1 From [" & shName & "$C3:C3] "
      sqlStr2 = "Select f1 From [" & shName & "$E16:E28] "
      For Each item In .SelectedItems
        cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & item & ";" & "Extended Properties=""Excel 12.0;HDR=No"";")
        With Sheets("Sheet2")
          ecol = .Range("AAA3").End(xlToLeft).Column
          .Cells(3, ecol + 1).CopyFromRecordset cn.Execute(sqlStr)
          .Cells(4, ecol + 1).CopyFromRecordset cn.Execute(sqlStr2)
        End With
        cn.Close
      Next item
      Set cn = Nothing
      MsgBox "Da Tong Hop Xong!"
      On Error GoTo 0
    End If
  End With
End Sub