[Xin giúp] Dùng Macro để ghép các file excel theo yêu cầu (3 người xem)

[881516]

Hi cả nhà,
Hiện tại e đang cần ghép file với số lượng cực lớn, nếu làm thủ công thì không biết khi nào xong ạ nên rất mong được cả nhà giúp đỡ.

em attach 1 ví dụ đơn giản như sau ạ
File Lop .xlsx là file chứa tên của các file cần ghép với nhau (cột A ghép với cột B) (macro cần đặt ở file này ạ)
Folder HS Gioi chứa các file cột A
Folder HS Kha chứa các file cột B
Folder Lop là nơi chứa file ghép lại, e làm sẵn 1 ví dụ là Lop 3A - Gioi Lop 3A - Kha.xlsx

(file thực tế e làm sẽ nhiều dòng và nhiều cột hơn vậy, nhưng số cột là giống nhau)

em trình bày dài dòng nhưng e nghĩ quy luật đơn giản, rất mong được cả nhà giúp đỡ ạ

E cảm ơn rất nhiều

 

[befaint]

Quy luật đơn giản nhưng số lượng files nhiều thế chắc bạn có máy tính cấu hình cao lắm đây. Mà chắc không phải dữ liệu của một trường phải không bạn?

 

[881516]

Quy luật đơn giản nhưng số lượng files nhiều thế chắc bạn có máy tính cấu hình cao lắm đây. Mà chắc không phải dữ liệu của một trường phải không bạn?

máy mình cũng bình thường thôi bạn, mình cũng xử lý nhiều file kiểu này rồi nhưng ko cần cấu hình cao lắm và cũng k tốn tài nguyên máy.
mình lấy ví dụ về trường học thôi, còn file thực tế của mình là sản xuất, bạn hình dung để lắp đc 1 chiếc điện thoại thì cần có main và khung máy, main thì lắp từ các linh kiện như chip, bộ nhớ ,... còn khung máy thì lắp từ màn hình, phím bấm, camera ... mình cần ghép 2 file lại để có 1 file tổng hợp các linh kiện để lắp đc máy đó :v rồi xử lý dữ liệu tiếp

 

[HieuCD]

Hi cả nhà,
Hiện tại e đang cần ghép file với số lượng cực lớn, nếu làm thủ công thì không biết khi nào xong ạ nên rất mong được cả nhà giúp đỡ.

em attach 1 ví dụ đơn giản như sau ạ
File Lop .xlsx là file chứa tên của các file cần ghép với nhau (cột A ghép với cột B) (macro cần đặt ở file này ạ)
Folder HS Gioi chứa các file cột A
Folder HS Kha chứa các file cột B
Folder Lop là nơi chứa file ghép lại, e làm sẵn 1 ví dụ là Lop 3A - Gioi Lop 3A - Kha.xlsx

(file thực tế e làm sẽ nhiều dòng và nhiều cột hơn vậy, nhưng số cột là giống nhau)

em trình bày dài dòng nhưng e nghĩ quy luật đơn giản, rất mong được cả nhà giúp đỡ ạ

E cảm ơn rất nhiều

Sub GPE()
  Dim wb As Workbook, cn As Object
  Dim wbArr()
  Dim iPath As String, tmp As String
  Dim i As Long, j As Long, eRow As Long, eCol As Long
 
  eRow = Range("A" & Rows.Count).End(xlUp).Row
  eCol = Range("AAA1").End(xlToLeft).Column
  If eRow < 2 Or eCol < 2 Then MsgBox "Khong co tap tin ": Exit Sub
  wbArr = Range("A1").Resize(eRow, eCol).Value
  iPath = ThisWorkbook.Path & "\"
  Set cn = CreateObject("ADODB.Connection")
 
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  For i = 2 To UBound(wbArr)
    tmp = iPath & wbArr(1, 1) & wbArr(i, 1) & ".xlsx"
    If Dir(tmp) <> "" Then
      Set wb = Workbooks.Open(tmp)
      ActiveSheet.UsedRange.ClearContents
    Else
      Set wb = Workbooks.Add
      wb.SaveAs Filename:=tmp
    End If
    For j = 2 To eCol
      If Len(wbArr(i, j)) Then
        eRow = Range("A" & Rows.Count).End(xlUp).Row
        If eRow > 1 Then eRow = eRow + 1
        tmp = iPath & wbArr(1, j) & wbArr(i, j) & ".xlsx"
        If Dir(tmp) <> "" Then
          cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tmp & ";Extended Properties=""Excel 12.0 macro;HDR=no;imex=1;"";")
          'Chinh dia chi "A1:D10000", "A2:D10000" phu hop file thuc te
          Cells(eRow, 1).CopyFromRecordset cn.Execute("select * from [Sheet1$" & IIf(j = 2, "A1:D10000", "A2:D10000") & "] where len(f1)>0 ")
          cn.Close
        End If
      End If
    Next j
    wb.Close True
  Next i
  If Not cn Is Nothing Then Set cn = Nothing
  Set wb = Nothing
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

 

[881516]

Cảm ơn bạn nhiều, hiện tại mình được share 1 code khác cũng rất thông minh và đơn giản như sau
Ghép file ở folder 1 và file ở folder 2, thành file mới lưu ở folder 3, link các folder đặt ở ô B2, B3, B4 như hình
Nhưng hiện tại mình gặp 1 vấn đề là dữ liệu file ở folder 2 kho copy sang file des bị đổi định dang, 1 số dữ liệu là 001234 thì bị đổi thành 1234
File ở folder 1 khi copy sang file des lại ko bị như vậy, nhờ bạn thêm code nhỏ để fix giúp mình nhé, mình att cả file lên ở đính kèm
Thanks

Sub MerFiles()
    Dim Exc As New Excel.Application
    Dim wb1, wb2 As Workbook
    Dim cl As Range
    With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .AskToUpdateLinks = False
    End With
            Set cl = Sheet1.Cells(7, 2)
            Do Until cl.Value = ""
            Set wb1 = Exc.Workbooks.Add(Sheet1.Cells(2, 2).Value & "\" & cl.Value)
            Set wb2 = Exc.Workbooks.Add(Sheet1.Cells(3, 2).Value & "\" & cl.Offset(0, 1).Value)
            wb1.Sheets(1).Cells(wb1.Sheets(1).UsedRange.Rows.Count + 1, 1).Resize(wb2.Sheets(1).UsedRange.Rows.Count - 1, wb2.Sheets(1).UsedRange.Columns.Count).Value = wb2.Sheets(1).UsedRange.Offset(1, 0).Resize(wb2.Sheets(1).UsedRange.Rows.Count - 1, wb2.Sheets(1).UsedRange.Columns.Count).Value
            wb2.Close False
            wb1.SaveAs Sheet1.Cells(4, 2).Value & "\" & cl.Offset(0, 2).Value, FileFormat:=51
            wb1.Close False
            Set cl = cl.Offset(1, 0)
            Loop
    Set wb1 = Nothing
    Set wb2 = Nothing
    Exc.Quit
    Set Exc = Nothing
    With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .AskToUpdateLinks = True
    End With
End Sub

 

[881516]

Sub GPE()
  Dim wb As Workbook, cn As Object
....
End Sub

mình test thử code này ko chạy bạn ah, bạn chỉnh giúp mình phần code bên ở #5 nhé