[Nhờ A/C giúp đỡ] Lấy nội dung có điều kiện (theo ngày) từ các file có sheet giống nhau thành 1 file

[watersnake]

Chào mọi người.

Em đang có nhiều file (VD: "File lay du lieu 1" & "File lay du lieu 2") có format và sheet giống nhau, chỉ khác nội dung chi tiết - bao gồm hình ảnh.
Nay em muốn gom các nội dung này lại với nhau vào chung 1 file tổng (File "SUM") nhưng lại chọn theo ngày A đến ngày B (Dữ liệu ngày ở cột B của sheet "File du lieu")
Trước đây, em có tham khảo mã VBA của 1 bạn trong nhóm thì gom được nội dung, nhưng không biết cách đổ theo ngày đã chọn (Cột B) a.
Nhờ mọi người giúp đỡ thêm.
File ví dụ như đính kèm.

Em cám ơn nhiều.

 

[HUONGHCKT]

Chào mọi người.

Em đang có nhiều file (VD: "File lay du lieu 1" & "File lay du lieu 2") có format và sheet giống nhau, chỉ khác nội dung chi tiết - bao gồm hình ảnh.
Nay em muốn gom các nội dung này lại với nhau vào chung 1 file tổng (File "SUM") nhưng lại chọn theo ngày A đến ngày B (Dữ liệu ngày ở cột B của sheet "File du lieu")
Trước đây, em có tham khảo mã VBA của 1 bạn trong nhóm thì gom được nội dung, nhưng không biết cách đổ theo ngày đã chọn (Cột B) a.
Nhờ mọi người giúp đỡ thêm.
File ví dụ như đính kèm.

Em cám ơn nhiều.

Bạn đã lấy được dữ liệu từ các file về file Tổng (File"SUM") rồi. thì thêm bước nữa là dùng Macro ghi lại tiến trình sử dụng bộ lọc nâng cao (advanced filter với 2 điêu kiện (từ ngày... đến ngày) lọc sang sheet khác là ổn thôi mà.

Cách khác là sau khi mở được file cần lấy thì dùng vòng lặp duyệt từng bản ghi, bản ghi nào có ngày tháng nằm trong khoảng từ ngày ... đến ngày thì lấy vào 1 mảng khác

Ví dụ: For i = 1 to ubound(arr)
if Arr(i,1) >= TuNgay and Arr(i,1)<= DenNgay then
t=t+1
For j= 1 to Ubound(arr,2)
Res(t,j)=Arr(i,j)

khi duyệt hết các file ta thu được Mảng Res có t dòng và j Ubound(arr,2).
tiến hành gán xuống sheet ta làm như sau:
tên sheet.Ô cần gán.Lấy ra vừa bằng kích thước mảng Res=Res
Vídu: Sheets("File du lieu").Range("A5").resize(t,Ubound(arr,2)=Res

Chúc bạn thành công.

 

[watersnake]

Bạn đã lấy được dữ liệu từ các file về file Tổng (File"SUM") rồi. thì thêm bước nữa là dùng Macro ghi lại tiến trình sử dụng bộ lọc nâng cao (advanced filter với 2 điêu kiện (từ ngày... đến ngày) lọc sang sheet khác là ổn thôi mà.

Cách khác là sau khi mở được file cần lấy thì dùng vòng lặp duyệt từng bản ghi, bản ghi nào có ngày tháng nằm trong khoảng từ ngày ... đến ngày thì lấy vào 1 mảng khác

Ví dụ: For i = 1 to ubound(arr)
if Arr(i,1) >= TuNgay and Arr(i,1)<= DenNgay then
t=t+1
For j= 1 to Ubound(arr,2)
Res(t,j)=Arr(i,j)

khi duyệt hết các file ta thu được Mảng Res có t dòng và j Ubound(arr,2).
tiến hành gán xuống sheet ta làm như sau:
tên sheet.Ô cần gán.Lấy ra vừa bằng kích thước mảng Res=Res
Vídu: Sheets("File du lieu").Range("A5").resize(t,Ubound(arr,2)=Res

Chúc bạn thành công.

Dạ cám ơn bạn nhiều.

Cách 1: Vì bộ data từ các file kia thật ra rất lớn (mình chỉ VD nên chỉ đưa vài nội dung đại diện), nên nếu gom về 1 sheet rồi mới filter thì sẽ rất nặng, nên ưu tiên lọc trước khi sao chép qua sheet file SUM a.

Cách 2: Xin lỗi, do mình không biết về VBA nhiều, chỉ copy mã về chỉnh sửa tên sheet này nọ để sử dụng nên không rõ ghi vào mã code như thế nào. Bạn có thể hỗ trợ làm trên file mình gửi để mình tham khảo được không a?

 

[HUONGHCKT]

Dạ cám ơn bạn nhiều.

Cách 1: Vì bộ data từ các file kia thật ra rất lớn (mình chỉ VD nên chỉ đưa vài nội dung đại diện), nên nếu gom về 1 sheet rồi mới filter thì sẽ rất nặng, nên ưu tiên lọc trước khi sao chép qua sheet file SUM a.

Cách 2: Xin lỗi, do mình không biết về VBA nhiều, chỉ copy mã về chỉnh sửa tên sheet này nọ để sử dụng nên không rõ ghi vào mã code như thế nào. Bạn có thể hỗ trợ làm trên file mình gửi để mình tham khảo được không a?

Cách 2 không lấy được hình ảnh trong ô mà chỉ lấy được dữ liệu trong ô thôi.

Option Explicit

Sub File_Tong()
Dim Wb As Workbook, Sh As Worksheet, Ws As Worksheet
Dim Arr(), Res()
Dim Lr&, R&, C&, n&, t&, i&, j&
Dim EDate As Date, SDate As Date
Dim FileMo As Variant
Dim openfile As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Wb = ActiveWorkbook
Set Sh = ActiveSheet
SDate = Sh.[E1]: EDate = Sh.[G1]
    
    'On Error Resume Next
    chonFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

If UBound(chonFile) = 0 Then Exit Sub
    n = 1
        ReDim Res(1 To 10000, 1 To 35)
        For Each FileMo In chonFile  ' quet tung file trong tap hop
                Set openfile = Workbooks.Open(Filename:=FileMo)
    With openfile
        For Each Ws In openfile.Sheets
            If Ws.Name Like "File du lieu" & "*" Then
                Lr = Ws.Cells(Rows.Count, 1).End(xlUp).Row
                Arr = Ws.Range("A5:AH" & Lr).Value2
                R = UBound(Arr): C = UBound(Arr, 2)
                Exit For
            End If
        Next Ws
        For i = 1 To R
            If Arr(i, 2) >= SDate And Arr(i, 2) <= EDate Then
                t = t + 1: Res(t, 1) = t: Res(n, C + 1) = FileMo
                For j = 2 To C
                    Res(t, j) = Arr(i, j)
                Next j
            End If
        Next i
    End With
    openfile.Close
n = t
Next FileMo

If t Then
    Sh.Range("A5").Resize(10000, C + 1).ClearContents
    Sh.Range("A5").Resize(t, C + 1) = Res
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done"
End Sub