Nhờ hỗ trợ xử lý code lấy dữ liệu từ nhiều sheet vào 1 sheet

[dungnt32]

Kính nhờ Các Anh Chị hỗ trợ giúp em tình huống sau với ạ:
Em đang cần lấy tất cả các dữ liệu từ 1 cột trong nhiều sheet excel (Mã KH từ các sheet nhỏ vào Mã KH của sheet sheet tổng hợp, đối với các giá trị trùng lặp thì chỉ list ra 1 lần.
Xin gửi AC file ạ!
Do số lượng row tại mỗi sheet có thể lên tới 500000 nên rất mong nhận được sự giúp đỡ của anh chị ạ!
Em cảm ơn!

 

[VetMini]

Toán căn bản:
- Nhiều sheets với mỗi sheet có thể nửa trệu dòng thì sheet tổng không thể chứa nổi.

Khả năng của sheet tổng chỉ có thể xấp xỉ 1 triệu dòng.

 

[HUONGHCKT]

Kính nhờ Các Anh Chị hỗ trợ giúp em tình huống sau với ạ:
Em đang cần lấy tất cả các dữ liệu từ 1 cột trong nhiều sheet excel (Mã KH từ các sheet nhỏ vào Mã KH của sheet sheet tổng hợp, đối với các giá trị trùng lặp thì chỉ list ra 1 lần.
Xin gửi AC file ạ!
Do số lượng row tại mỗi sheet có thể lên tới 500000 nên rất mong nhận được sự giúp đỡ của anh chị ạ!
Em cảm ơn!

Thử tham khảo code sau:

Option Explicit

Sub LayMaKH()
Dim i&, R&, Lr&, t&
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet, Cell As Range
Set Dic = CreateObject("Scripting.Dictionary")
On Error GoTo Loi
For Each Sh In Worksheets
    If Sh.Name <> "TONGHOP" Then
        Lr = Sh.Cells(1000000, 2).End(xlUp).Row
        R = Application.Match("STT", Sh.Range("A1:A1000000"), 0) + 1
        For Each Cell In Sh.Range("B" & R, "B" & Lr)
                Key = VBA.Trim(Cell)
                If Not Dic.Exists(Key) Then
                    t = t + 1: Dic.Add (Key), t
                End If
        Next Cell
    End If
Next Sh
If t Then
        Set Ws = Sheets("TONGHOP")
        Ws.Range("B3:B" & Rows.Count).ClearContents
    If t <= 1048574 Then
        Ws.Range("B3").Resize(t) = Application.Transpose(Dic.Keys)
        Ws.Range("B3").Resize(t).NumberFormat = "000000###"
        MsgBox "Done"
    Else
        Ws.Range("B3").Resize(1048574) = Application.Transpose(Dic.Keys)
        Ws.Range("B3").Resize(1048574).NumberFormat = "000000###"
        MsgBox "Done"
    End If
End If
Loi:
If Err.Number Then
    MsgBox "Da có loi"
    Exit Sub
End If
End Sub

Bạn đổi tên Sheet Tổng hợp thành TONGHOP

Hy vọng là trong nhiều sheet cần lấy mã ấy, có nhiều mã trùng nhau và tổng số mã không trùng <=1.000.000