UNIQUE CODE VBA (2 người xem)

[vucongvi]

Dạ em chào anh/chị
Em xin nhờ các a/c hỗ trợ giúp em trường hợp này.
Ở Excel hiện tại của công ty em không có hàm Unique (lọc giá trị trùng) và em có thử 1 số code vba thay thế Unique Function nhưng chỉ lọc lấy được giá trị trùng trên 1 cột chứ không hoàn toàn nhiều vùng được chọn như Unique của Excel
Nhờ các sếp hỗ trợ giúp em
Cột A và Cột B (Data)
Cột E => Lọc giá trị trùng ở Cột B
Cột D => sẽ theo giá trị ngày của cột A

Nhờ anh chị xem file đính kèm và giúp em ạ
EM cảm ơn anh chị

 

[thanthanhan]

Dạ em chào anh/chị
Em xin nhờ các a/c hỗ trợ giúp em trường hợp này.
Ở Excel hiện tại của công ty em không có hàm Unique (lọc giá trị trùng) và em có thử 1 số code vba thay thế Unique Function nhưng chỉ lọc lấy được giá trị trùng trên 1 cột chứ không hoàn toàn nhiều vùng được chọn như Unique của Excel
Nhờ các sếp hỗ trợ giúp em
Cột A và Cột B (Data)
Cột E => Lọc giá trị trùng ở Cột B
Cột D => sẽ theo giá trị ngày của cột A

Nhờ anh chị xem file đính kèm và giúp em ạ
EM cảm ơn anh chị

Bạn dùng Pivot Table đi cho lẹ, có ngày mới, tên mới thì refresh lại là được rồi

 

[bebo021999]

Nếu bạn muốn trích lọc nhiều điều kiện (như ví dụ là 2 điều kiện. Nhiều hơn thì dùng VBA), với Excel thấp, thì dùng INDEX(MATCH(COUNTIFS như sau
Ô D2 copy xuống và sang phải:

=IFERROR(INDEX(A$3:A$20,MATCH(0,INDEX(COUNTIFS($D$2:D2,$A$3:$A$20,$E$2:E2,$B$3:$B$20),),0)),"")

 

[thuytrangbp28]

Nếu Excel của bạn không hỗ trợ công thức mảng động thì mình khuyên bạn nên dùng chức năng Remove Duplicates có sẵn, code chỉ thêm rườm rà.
Còn nếu bạn vẫn muốn dùng code thì tham khảo code bên dưới, bạn phải nhập giống kiểu công thức mảng truyền thống, nghĩa là chọn vùng cần điền kết quả, nhập công thức và kết thúc bằng Ctrl+Shift+Enter (nếu 365 hoặc 2024 thì nhập bình thường). Mình không muốn viết Sub vì khi chạy chọn vùng cần lọc rồi chọn ô điền kết quả thì dùng Remove Duplicates sẽ hợp lý hơn

Function Loc_trung(rng As Range) As Variant
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    Dim r As Long, c As Long
    Dim key As String
    Dim data As Variant
    Dim result() As Variant
    Dim item As Variant
    Dim i As Long
    Dim numCols As Long

    data = rng.Value
    
    ' Chi chon 1 o
    If Not IsArray(data) Then
        Loc_trung = Array(data)
        Exit Function
    End If
    
    For r = 1 To UBound(data, 1)
        key = ""
        For c = 1 To UBound(data, 2)
            key = key & "|" & Trim(CStr(data(r, c)))
        Next c
      
        If Not dict.exists(key) Then
            dict.Add key, key
        End If
    Next r

    numCols = rng.Columns.Count
    ReDim result(1 To dict.Count, 1 To numCols)
    i = 1

    For Each item In dict.Keys
        Dim parts() As String
        parts = Split(Mid(item, 2), "|")
        For c = 1 To numCols
            result(i, c) = parts(c - 1)
        Next c
        i = i + 1
    Next item

    Loc_trung = result
End Function