Nhờ giúp: macro Tổng hợp dữ liệu từ nhiều file

[881516]

Chào mọi người,
Mình có 1 ví dụ như dưới đây.
3 file Lop 5A, Lop 5B, Lop 5C.
Số cột mỗi file cố định, số dòng thay đổi ko cố định vì mỗi lớp số học sinh khác nhau
mình cần làm 1 macro copy dữ liệu từ 3 file trên, vào 1 file là Truong tieu hoc X.
Copy cả dòng họ, tên, ngày sinh ... cũng ko sao
Nhưng cần 1 điều kiện quan trọng là các ô tại cột H của file tổng hợp phải ghi tên file, tức là các cột từ A -> G copy dữ liệu từ file nào thì điền tên file đó vào cột H (điền tất cả các ô trong cột)

Kết quả như file mình up lên.

Trên đây là ví dụ minh họa, thực tế công việc mình làm 150-200 file như này đặt trong 1 thư mục.

Mong mọi người giúp đỡ để mình tiết đc thời gian làm việc.

 

[PacificPR]

Chào mọi người,
Mình có 1 ví dụ như dưới đây.
3 file Lop 5A, Lop 5B, Lop 5C.
Số cột mỗi file cố định, số dòng thay đổi ko cố định vì mỗi lớp số học sinh khác nhau
mình cần làm 1 macro copy dữ liệu từ 3 file trên, vào 1 file là Truong tieu hoc X.
Copy cả dòng họ, tên, ngày sinh ... cũng ko sao
Nhưng cần 1 điều kiện quan trọng là các ô tại cột H của file tổng hợp phải ghi tên file, tức là các cột từ A -> G copy dữ liệu từ file nào thì điền tên file đó vào cột H (điền tất cả các ô trong cột)

Kết quả như file mình up lên.

Trên đây là ví dụ minh họa, thực tế công việc mình làm 150-200 file như này đặt trong 1 thư mục.

Mong mọi người giúp đỡ để mình tiết đc thời gian làm việc.

Bạn thử Code này xem sao:

Sub ImportData()
    Dim Master As Worksheet, Sh As Worksheet, wk As Workbook
    Dim strFolderPath As String, strFileName As String, Tenfile As String
    Dim v As Variant, Er As Long, Tmp1, Tmp2
    Dim Arr As Variant, sArr, dArr, I As Long, J As Long
Application.ScreenUpdating = False
Set Master = ActiveWorkbook.Sheets("Sheet1")
Master.Range("A2:H" & Master.Range("A65535").End(3).Row + 1).ClearContents
On Error GoTo Thoat
Arr = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
For v = LBound(Arr) To UBound(Arr)
    strFileName = Arr(v)
    Tmp1 = Split(strFileName, "\"): Tmp2 = Split(Tmp1(UBound(Tmp1)), "."): Tenfile = Tmp2(0)
    Set wk = Workbooks.Open(strFileName)
    For Each Sh In wk.Sheets
        If Sh.Name = "Sheet1" Then
            With Sh
                sArr = .Range("A2", .Range("A65535").End(3)).Resize(, 7).Value
                ReDim dArr(1 To UBound(sArr), 1 To 8)
                For I = 1 To UBound(sArr)
                    If sArr(I, 1) <> Empty Then
                        K = K + 1
                        For J = 1 To 7
                            dArr(K, J) = sArr(I, J)
                        Next J
                        dArr(K, 8) = Tenfile
                    End If
                Next I
            End With
            With Master
                Er = .Range("A65535").End(3).Row
                .Range("A" & Er + 1).Resize(K, 8) = dArr
            End With
        End If
        Exit For
    Next Sh
    wk.Close
    Erase dArr: K = 0
Next
MsgBox "Qua trinh lay du lieu hoan thanh   "
Thoat:
Exit Sub
Application.ScreenUpdating = True
End Sub

 

[phulien1902]

Bạn thử Code này xem sao:

Sub ImportData()
    Dim Master As Worksheet, Sh As Worksheet, wk As Workbook
    Dim strFolderPath As String, strFileName As String, Tenfile As String
    Dim v As Variant, Er As Long, Tmp1, Tmp2
    Dim Arr As Variant, sArr, dArr, I As Long, J As Long
Application.ScreenUpdating = False
Set Master = ActiveWorkbook.Sheets("Sheet1")
Master.Range("A2:H" & Master.Range("A65535").End(3).Row + 1).ClearContents
On Error GoTo Thoat
Arr = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
For v = LBound(Arr) To UBound(Arr)
    strFileName = Arr(v)
    Tmp1 = Split(strFileName, "\"): Tmp2 = Split(Tmp1(UBound(Tmp1)), "."): Tenfile = Tmp2(0)
    Set wk = Workbooks.Open(strFileName)
    For Each Sh In wk.Sheets
        If Sh.Name = "Sheet1" Then
            With Sh
                sArr = .Range("A2", .Range("A65535").End(3)).Resize(, 7).Value
                ReDim dArr(1 To UBound(sArr), 1 To 8)
                For I = 1 To UBound(sArr)
                    If sArr(I, 1) <> Empty Then
                        K = K + 1
                        For J = 1 To 7
                            dArr(K, J) = sArr(I, J)
                        Next J
                        dArr(K, 8) = Tenfile
                    End If
                Next I
            End With
            With Master
                Er = .Range("A65535").End(3).Row
                .Range("A" & Er + 1).Resize(K, 8) = dArr
            End With
        End If
        Exit For
    Next Sh
    wk.Close
    Erase dArr: K = 0
Next
MsgBox "Qua trinh lay du lieu hoan thanh   "
Thoat:
Exit Sub
Application.ScreenUpdating = True
End Sub

Bạn làm quá nhanh, quá xuất sắc.

 

[881516]

Bạn thử Code này xem sao:

Hi bạn
Mình nhờ thế này bạn đừng cười nhé bạn có thể add luôn macro vào file Truong tieu hoc X .xlsx kia giúp mình đc ko, mình mới bắt đầu tiếp xúc với macro, tự thêm vào toàn bị lỗi.
Với cả các file dữ liệu mình đặt trong 1 đường dẫn là C:\Users\Hung\Desktop\test
Trên code mình thấy:
Set Master = ActiveWorkbook.Sheets("Sheet1") => có vẻ như phải mở hết các file lên ah bạn

 

[PacificPR]

Hi bạn
Mình nhờ thế này bạn đừng cười nhé bạn có thể add luôn macro vào file Truong tieu hoc X .xlsx kia giúp mình đc ko, mình mới bắt đầu tiếp xúc với macro, tự thêm vào toàn bị lỗi.
Với cả các file dữ liệu mình đặt trong 1 đường dẫn là C:\Users\Hung\Desktop\test
Trên code mình thấy:
Set Master = ActiveWorkbook.Sheets("Sheet1") => có vẻ như phải mở hết các file lên ah bạn

Bạn chỉ cần mở file Truong tieu hoc thôi. Khi bấm vào nút Lấy dữ liệu xuất hiện hộp thoại bạn chọn đường dẫn đến thư mục chứa file con và chọn file cần lấy dữ liệu

 

[PacificPR]

Bạn làm quá nhanh, quá xuất sắc.

Có file mẫu rồi anh ơi. Chỉ sửa 1 chút là được (Cái này em cũng đi lượm về chỉ thêm thắt 1 chút thôi anh ạ)

 

[HieuCD]

Chào mọi người,
Mình có 1 ví dụ như dưới đây.
3 file Lop 5A, Lop 5B, Lop 5C.
Số cột mỗi file cố định, số dòng thay đổi ko cố định vì mỗi lớp số học sinh khác nhau
mình cần làm 1 macro copy dữ liệu từ 3 file trên, vào 1 file là Truong tieu hoc X.
Copy cả dòng họ, tên, ngày sinh ... cũng ko sao
Nhưng cần 1 điều kiện quan trọng là các ô tại cột H của file tổng hợp phải ghi tên file, tức là các cột từ A -> G copy dữ liệu từ file nào thì điền tên file đó vào cột H (điền tất cả các ô trong cột)

Kết quả như file mình up lên.

Trên đây là ví dụ minh họa, thực tế công việc mình làm 150-200 file như này đặt trong 1 thư mục.

Mong mọi người giúp đỡ để mình tiết đc thời gian làm việc.

giải nén mở file truong... chạy code

 Sub GopLop()
  Dim Sh As Worksheet, Wb_k As Workbook, Filename As String, Path As String
  Dim LastR As Long, Arr()
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Set Sh = ThisWorkbook.Sheets("Sheet1")
  LastR = Sh.Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then Sh.Range("A2:H" & LastR).Clear
 
  Path = ThisWorkbook.Path
  Filename = Dir(Path & "\*.xlsx", vbNormal)
  If Len(Filename) = 0 Then Exit Sub
  Do Until Filename = vbNullString
    If Not Filename = ThisWorkbook.Name Then
      Set Wb_k = Workbooks.Open(Filename:=Path & "\" & Filename)
        With Wb_k.Sheets("Sheet1")
          LastR = .Range("A" & Rows.Count).End(xlUp).Row
          If LastR > 1 Then
            Arr = .Range("A2:G" & LastR).Value
            LastR = Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
            Sh.Range("A" & LastR).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
          End If
         End With
      Wb_k.Close False
      Sh.Range("H" & LastR) = Left(Filename, Len(Filename) - 5)
      Sh.Range("H" & LastR).AutoFill Destination:=Sh.Range("H" & LastR).Resize(UBound(Arr))
    End If
    Filename = Dir()
  Loop
  Sh.Range("A2:H" & Sh.Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = 1
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  MsgBox "Tong Hop Xong!"
End Sub

 

[881516]

Cảm ơn mọi người rất nhiều, với 1 người mới biết về macro với mình như này chỉ biết gọi là vi diệu.
Đúng là có nhiều cái để học hỏi quá..

Hiện mình cũng nhờ đc 1 người viết hộ 1 file macro của 1 bài toán khác, nhưng hiện có bất tiện là các file con phải đặt trong 1 thư mục, và mỗi lần chạy macro này, nó auto mở từng file rồi tự tắt file đó, cứ như vậy cho đến hết => ngồi uống cốc cafe chờ kết quả

với macro này mình thấy rất hay, nó cho mình chọn file cần lấy dữ liệu và gần như ngay tức thì, quả là võ công cao cường.

Nếu đc phép mình xin nhờ mọi người chỉnh sửa file đó hiệu quả như file này đc ko

 

[quanluu]

Cảm ơn mọi người rất nhiều, với 1 người mới biết về macro với mình như này chỉ biết gọi là vi diệu.
Đúng là có nhiều cái để học hỏi quá..

Hiện mình cũng nhờ đc 1 người viết hộ 1 file macro của 1 bài toán khác, nhưng hiện có bất tiện là các file con phải đặt trong 1 thư mục, và mỗi lần chạy macro này, nó auto mở từng file rồi tự tắt file đó, cứ như vậy cho đến hết => ngồi uống cốc cafe chờ kết quả

với macro này mình thấy rất hay, nó cho mình chọn file cần lấy dữ liệu và gần như ngay tức thì, quả là võ công cao cường.

Nếu đc phép mình xin nhờ mọi người chỉnh sửa file đó hiệu quả như file này đc ko

Các code trên đều thao tác mở file lấy dữ liệu rồi đóng file hết. Cái quan trọng ở đây là code lấy dữ liệu xử lý nhanh hay chậm (nhanh thì bạn khó nhận biết là người ta mở file, code xử chưa tối ưu - xử lý chậm thì bạn có thể thấy rõ người ta đang mở file) và dung lượng của file lấy dự liệu.

 

[881516]

Có file mẫu rồi anh ơi. Chỉ sửa 1 chút là được (Cái này em cũng đi lượm về chỉ thêm thắt 1 chút thôi anh ạ)

Thanks bạn nhiều nha

 

[881516]

giải nén mở file truong... chạy code

 Sub GopLop()
  Dim Sh As Worksheet, Wb_k As Workbook, Filename As String, Path As String
  Dim LastR As Long, Arr()
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Set Sh = ThisWorkbook.Sheets("Sheet1")
  LastR = Sh.Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then Sh.Range("A2:H" & LastR).Clear
 
  Path = ThisWorkbook.Path
  Filename = Dir(Path & "\*.xlsx", vbNormal)
  If Len(Filename) = 0 Then Exit Sub
  Do Until Filename = vbNullString
    If Not Filename = ThisWorkbook.Name Then
      Set Wb_k = Workbooks.Open(Filename:=Path & "\" & Filename)
        With Wb_k.Sheets("Sheet1")
          LastR = .Range("A" & Rows.Count).End(xlUp).Row
          If LastR > 1 Then
            Arr = .Range("A2:G" & LastR).Value
            LastR = Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
            Sh.Range("A" & LastR).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
          End If
         End With
      Wb_k.Close False
      Sh.Range("H" & LastR) = Left(Filename, Len(Filename) - 5)
      Sh.Range("H" & LastR).AutoFill Destination:=Sh.Range("H" & LastR).Resize(UBound(Arr))
    End If
    Filename = Dir()
  Loop
  Sh.Range("A2:H" & Sh.Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = 1
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  MsgBox "Tong Hop Xong!"
End Sub

Hi bạn
File của bạn OK
nhưng ví dụ tên lớp của mình là AK1 thì ở cột tên file nó nhảy tên lớp là AK1, AK2, AK3 chứ tất cả các học sinh trong lớp ko phải là AK1 nữa
b xem fix chỗ nào

 

[tuandandy]

Các code trên đều thao tác mở file lấy dữ liệu rồi đóng file hết. Cái quan trọng ở đây là code lấy dữ liệu xử lý nhanh hay chậm (nhanh thì bạn khó nhận biết là người ta mở file, code xử chưa tối ưu - xử lý chậm thì bạn có thể thấy rõ người ta đang mở file) và dung lượng của file lấy dự liệu.

bạn ơi ví dụ 1 file có 30 sheet thì mình làm thế nào để nó lấy dữ liệu của các sheet vậy

 

[PacificPR]

Hi bạn
File của bạn OK
nhưng ví dụ tên lớp của mình là AK1 thì ở cột tên file nó nhảy tên lớp là AK1, AK2, AK3 chứ tất cả các học sinh trong lớp ko phải là AK1 nữa
b xem fix chỗ nào

File con có 18 cột và file có 19 cột ( Cột S là tên lớp) hả bạn. Nếu vậy bạn xem thử file đính kèm nha

 

[PacificPR]

bạn ơi ví dụ 1 file có 30 sheet thì mình làm thế nào để nó lấy dữ liệu của các sheet vậy

Bạn cho nó vào vòng lặp. Khi mở file lên duyệt qua các Sheet là được

 

[phulien1902]

File con có 18 cột và file có 19 cột ( Cột S là tên lớp) hả bạn. Nếu vậy bạn xem thử file đính kèm nha

Nếu nói cột S là tên lớp thì Code phải sửa:

dArr(K, 8) = Tenfile

thành

dArr(K, 19) = Tenfile

phải không PacificPR?

 

[PacificPR]

Nếu nói cột S là tên lớp thì Code phải sửa:

dArr(K, 8) = Tenfile

thành

dArr(K, 19) = Tenfile

phải không PacificPR?

Dạ. Em lại quên không sửa chỗ đó. Để em đính kèm lại file. Cám ơn anh nhiều

 

[881516]

Dạ. Em lại quên không sửa chỗ đó. Để em đính kèm lại file. Cám ơn anh nhiều

Hi bạn, chỗ 8 với 18 mình sửa ok rồi.
Nhưng mình đang bị 1 vẫn đề là cứ import từ 1 file thì nó hỏi MsgBox update 2 lần,
Mình mở 50 file 1 lúc cứ ngồi enter update thôi

 

[PacificPR]

Hi bạn, chỗ 8 với 18 mình sửa ok rồi.
Nhưng mình đang bị 1 vẫn đề là cứ import từ 1 file thì nó hỏi MsgBox update 2 lần,
Mình mở 50 file 1 lúc cứ ngồi enter update thôi

Bạn tải lại file bài 13. Còn cái Update là do file con của bạn có liên kết đến 1 file nào đó khi mở hiện cái bảng đó thôi

 

[quanluu]

Hi bạn, chỗ 8 với 18 mình sửa ok rồi.
Nhưng mình đang bị 1 vẫn đề là cứ import từ 1 file thì nó hỏi MsgBox update 2 lần,
Mình mở 50 file 1 lúc cứ ngồi enter update thôi

Vấn đề update link thì xử lý thế này xem sao:
Thêm dòng Application.DisplayAlerts = False ở đầu code (trước thằng ScreenUpdating)
và Application.DisplayAlerts = True cuối code (sau thằng Screen..)

 

[881516]

Bạn tải lại file bài 13. Còn cái Update là do file con của bạn có liên kết đến 1 file nào đó khi mở hiện cái bảng đó thôi

ah đúng rồi bạn ah, có 1 file excel khác cũng sử dụng dữ liệu từ file này nhưng file đó đang ko bật lên.
Và mình cũng copy toàn bộ những file con ra 1 folder khác mà, sao vẫn bị hiện update nhỉ