Nối dữ liệu theo tên Sheet ở nhiều file (1 người xem)

tranphuson · 14/3/24

Vui lòng giúp mình nối dữ liệu các Sheet giống tên với nhau theo nhiều file năm khác nhau:

1. File "năm 2020" có các Sheet "Jan, Feb,...." => khi mở file này lên thì chọn các file cần nối vào dựa theo tên Sheet giống nhau
Ví dụ: File 2020 có Sheet "Jan" thì sẽ được nối với File "năm 2021" cũng có Sheet "Jan", nối tiếp file "Năm 2022" cũng có Sheet "Jan".....

2. Nội dung được nối vào file "Năm 2020" thì nằm ở dòng cuối Sheet "Jan" không được xóa hay đè lên dữ liệu đang có ở Sheet đó

Lấy file "Năm 2020" làm chuẩn dựa theo các Sheet có sẵn "Jan, Feb, Mar..." nối các file khác vào dựa theo file "Năm 2020" với các tên Sheet <đang có sẵn>

Xin cảm ơn

HUONGHCKT · 14/3/24

tranphuson đã viết:
Vui lòng giúp mình nối dữ liệu các Sheet giống tên với nhau theo nhiều file năm khác nhau:

1. File "năm 2020" có các Sheet "Jan, Feb,...." => khi mở file này lên thì chọn các file cần nối vào dựa theo tên Sheet giống nhau
Ví dụ: File 2020 có Sheet "Jan" thì sẽ được nối với File "năm 2021" cũng có Sheet "Jan", nối tiếp file "Năm 2022" cũng có Sheet "Jan".....

2. Nội dung được nối vào file "Năm 2020" thì nằm ở dòng cuối Sheet "Jan" không được xóa hay đè lên dữ liệu đang có ở Sheet đó

Lấy file "Năm 2020" làm chuẩn dựa theo các Sheet có sẵn "Jan, Feb, Mar..." nối các file khác vào dựa theo file "Năm 2020" với các tên Sheet <đang có sẵn>

Xin cảm ơn

@tranphuson Tham khảo đoạn code sau:

Mã:

Option Explicit

Public arr()

Sub GetMultipleFiles()
Dim ir&
    Dim fDialog As Object
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = True
        .Title = "Please select the files"
        .Filters.Clear
        .Filters.Add "All supported files", "*.xls*;*.xl*"
        .Filters.Add "Excel 97 Files", "*.xl?"
        .Filters.Add "Excel Files", "*.xls?"

        If .Show = True Then
            Dim fPath As Variant
            For Each fPath In .SelectedItems
                ir = ir + 1
                ReDim Preserve arr(1 To ir)
                arr(ir) = fPath
            Next
        End If
        On Error Resume Next
        ir = UBound(arr)
        If Err.Number = 9 Then Exit Sub
    End With
End Sub

Sub TongHop()
Dim Wb As Workbook, Sh As Worksheet, Ws As Worksheet
Dim Ten As String
Dim i&, j&, Col&, Lr&, R&, dong&
Dim Data As Range
GetMultipleFiles
If Err.Number > 0 Then Exit Sub
On Error GoTo Loi '0
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Set tWb = ThisWorkbook
For i = 1 To UBound(arr)
    Set Wb = Workbooks.Open(arr(i))
    For Each Ws In sWb.Worksheets
         Ten = Ws.Name
            For j = 1 To 10
                If Ws.Range("A" & j) <> Empty Then
                    Col = Ws.Cells(j, 1000).End(xlToLeft).Column
                    Lr = Ws.Range("C100000").End(xlUp).Row
                    Set Data = Ws.Range(Ws.Cells(j, 1), Ws.Cells(Lr, Col))
                    Exit For
                End If
            Next j

           Windows("Năm 2020.xlsm").Activate
            For Each Sh In Worksheets
                If Sh.Name Like Ten Then
                    dong = Sh.Range("C100000").End(xlUp).Row + 1
                    Data.Copy Sh.Range("A" & dong) '.Resize(R, Col) = Data
                    Exit For
                End If
            Next Sh
    Next Ws
    Wb.Close
Next i
Loi:
If Err Then
    MsgBox "Da có lôi"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Msgbox " Đái nối các file về file Tông hơp thành công"
End Sub

Hy vọng đúng ý

tranphuson · 14/3/24

HUONGHCKT đã viết:

@tranphuson Tham khảo đoạn code sau:

Mã:

Option Explicit

Public arr()

Sub GetMultipleFiles()
Dim ir&
    Dim fDialog As Object
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = True
        .Title = "Please select the files"
        .Filters.Clear
        .Filters.Add "All supported files", "*.xls*;*.xl*"
        .Filters.Add "Excel 97 Files", "*.xl?"
        .Filters.Add "Excel Files", "*.xls?"

        If .Show = True Then
            Dim fPath As Variant
            For Each fPath In .SelectedItems
                ir = ir + 1
                ReDim Preserve arr(1 To ir)
                arr(ir) = fPath
            Next
        End If
        On Error Resume Next
        ir = UBound(arr)
        If Err.Number = 9 Then Exit Sub
    End With
End Sub

Sub TongHop()
Dim Wb As Workbook, Sh As Worksheet, Ws As Worksheet
Dim Ten As String
Dim i&, j&, Col&, Lr&, R&, dong&
Dim Data As Range
GetMultipleFiles
If Err.Number > 0 Then Exit Sub
On Error GoTo Loi '0
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Set tWb = ThisWorkbook
For i = 1 To UBound(arr)
    Set Wb = Workbooks.Open(arr(i))
    For Each Ws In sWb.Worksheets
         Ten = Ws.Name
            For j = 1 To 10
                If Ws.Range("A" & j) <> Empty Then
                    Col = Ws.Cells(j, 1000).End(xlToLeft).Column
                    Lr = Ws.Range("C100000").End(xlUp).Row
                    Set Data = Ws.Range(Ws.Cells(j, 1), Ws.Cells(Lr, Col))
                    Exit For
                End If
            Next j

           Windows("Năm 2020.xlsm").Activate
            For Each Sh In Worksheets
                If Sh.Name Like Ten Then
                    dong = Sh.Range("C100000").End(xlUp).Row + 1
                    Data.Copy Sh.Range("A" & dong) '.Resize(R, Col) = Data
                    Exit For
                End If
            Next Sh
    Next Ws
    Wb.Close
Next i
Loi:
If Err Then
    MsgBox "Da có lôi"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Msgbox " Đái nối các file về file Tông hơp thành công"
End Sub

Hy vọng đúng ý

Vui lòng hướng dẫn rõ thêm vì mình làm theo cách này không biết đúng ý bạn code không hay phải làm cách nào khác!

* Cách 1: Mở 1 file "Năm 2020" rồi chạy đoạn code trên xong hiện ra thông báo chọn file => Mình chọn file "Năm 2021" xong rồi không thấy thay đổi gì hết

* Cách 2: Mở hết file "Năm 2020" rồi chạy đoạn code trên xong hiện ra thông báo chọn file => Mình chọn file "Năm 2021, 2022, 2023, 2024" xong rồi cũng không thấy thay đổi gì hết

Cảm ơn

HUONGHCKT · 14/3/24

tranphuson đã viết:
Vui lòng hướng dẫn rõ thêm vì mình làm theo cách này không biết đúng ý bạn code không hay phải làm cách nào khác!

* Cách 1: Mở 1 file "Năm 2020" rồi chạy đoạn code trên xong hiện ra thông báo chọn file => Mình chọn file "Năm 2021" xong rồi không thấy thay đổi gì hết

* Cách 2: Mở hết file "Năm 2020" rồi chạy đoạn code trên xong hiện ra thông báo chọn file => Mình chọn file "Năm 2021, 2022, 2023, 2024" xong rồi cũng không thấy thay đổi gì hết

Cảm ơn

View attachment 299614 View attachment 299613

Tôi nói sơ bộ cách thức code hoạt động thế này nhé:
Khi chạy code nó sẽ hiện 1 bảng cho ta chọn file. Chọn 1 hoặc nhiều file xong nhấn OK. code sẽ chạy tiếp nó sẽ mở từng file ra và duyệt từng Sh trong workbook ấy và lấy tên Sheet. Khi duyệt các Sh code sẽ duyệt khoảng 5 dòng đầu để tìm dòng có dữ liệu, và tìm dòng cuối, cột cuối===> đưa vào một Range (vùng này chính là vùng có dữ liệu)==> thoát khỏi vòng lặp, tiếp đến Code sẽ kích hoạt Workbook chứa code, và bước vào vòng lặp duyệt từng sheet, nếu tên Sheet trùng với tên Sh nguồn đã lấy được thì tìm dòng cuối của sheet ấy ===>Copy vùng đã tìm được và paste vào sheet ở vị trí ô Adòng cuối +1. Cứ thế code sẽ duyệt hết sheet của file nguồn và paste vào các sheet của file đích (dùng copy và paste sẽ mang theo sang cả định dạng) sau đó sẽ đóng file nguồn và lại tiếp tực mở file nguồn kế tiếp và lại thực hiện như đã diễn giải ở trên.
Khi code chạy bị vấp lỗi: một thông báo sẽ hiện ra
Khi hoàn tất việc nối file => một thông báo sẽ hiện ra báo cho bạn biến là đã thành công.
Bạn có thể thử xem cách thức code hoạt động bằng cách cho chạy từng dòng code (nhấn F8), hoặc từng đoạn code bằng cách đánh dấu ngoài lề của module và nhấn F5
Trong file đính kèm dưới đây tôi đã để code chép luôn tên File và tên sheet được lấy của file nguồn ( sau cột cuối cùng).
Cảnh báo: Nếu 1 file nguồn được lấy nhiều hơn 1 lần thì dữ liệu ở file đích sẽ bị trùng.
Tôi tin là bạn biết điều này và có hướng khắc phục.
Nếu vẫn không được hoặc có vấn đề gì về nối file hoặc để làm cảnh báo trên thì bạn có thể Zalo cho tôi (ngay dưới nickname), tôi sẽ hướng dẫn cụ thể hơn.
Chúc vui, khỏe, thành công.

VetMini · 14/3/24

Nối xong rồi thì làm cách nào để biết trong sheet Jan, từ đâu đến đâu là 2020, từ đâu là 2021?
Muốn kiểm soát sai sót thì làm cách nào?

giaiphap · 14/3/24

VetMini đã viết:
Nối xong rồi thì làm cách nào để biết trong sheet Jan, từ đâu đến đâu là 2020, từ đâu là 2021?
Muốn kiểm soát sai sót thì làm cách nào?

Vụ kiểm soát do bộ phận khác làm nhé bác, tui chỉ việc nối dữ liệu vào thôi. Còn nếu giúp thì giúp cho trót luôn, tạo thêm cột tên file và cột tên sheet nửa là xong.

VetMini · 15/3/24

Theo lô gic thì bài này đâu có cần chọn files? Chọn chỉ mất công sai sót.

1. Mở file chính (2020). Chạy code.
2. Parse tên file, lấy con số cuối (2020)
3. Vòng lặp NĂM bắt đầu mở từ file 2021 đến hết số files 20??
3.1 Vòng lặp THÁNG bắt đầu từ Jan đến Dec (Sheets)
3.1.1. Copy dữ liệu của sheet tương ứng
3.1.2. Tử tế thì thêm 2 cột, cột tên file đang copied và cột chỉ số dòng
3.1.3. Hết vòng lặp THÁNG
3.2. Hết vòng lặp NĂM
3.3. Hết

Chú 1: Bài này chỉ nên copy thẳng, đừng dùng những kỹ thuật như ADO. ADO có cái bug là nếu mở đóng nhiều lần quá nó sẽ bị kẹt bộ nhớ.

Nối dữ liệu theo tên Sheet ở nhiều file (1 người xem)

Người dùng đang xem chủ đề này

tranphuson

Thành viên thường trực

File đính kèm

HUONGHCKT

Zalo 0986997214

tranphuson

Thành viên thường trực

HUONGHCKT

Zalo 0986997214

File đính kèm

VetMini

Ăn cùng góc phố

giaiphap

==(^o^)==

VetMini

Ăn cùng góc phố

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian