Lọc danh sách bằng vba

Bạn cần phải lọc một danh sách duy nhất từ một danh sách đầy thông tin trùng lắp với nhau, bạn có thế sử dụng chức năng "remove duplicates" để giải quyết nó. Nhưng phải làm thế nào với trường hợp dùng VBA để lọc.

 

Dưới đây sẽ là code để bạn biết cách làm thế nào để có thể lọc ra danh sách duy nhất từ một danh sách có các giá trị trùng lắp với nhau.

Sub LocDuLieu_Duynhat()



    Dim vaData As Variant

    Dim colUnique As Collection

    Dim aOutput() As Variant

    Dim i As Long

    Dim LastRow As Long

    LastRow = Worksheets(Sheet1.Name).Cells(2, "A").End(xlDown).Row


    'Lay du lieu can loc dua vao mang

    vaData = Sheet1.Range("A2:G" & LastRow).Value


    'Create a new collection

    Set colUnique = New Collection

    'Loop through the data

    For i = LBound(vaData, 1) To UBound(vaData, 1)

        'Collections can't have duplicate keys, so try to

        'add each item to the collection ignoring errors.

        'Only unique items will be added

        On Error Resume Next

            colUnique.Add vaData(i, 1), CStr(vaData(i, 1))

        On Error GoTo 0

    Next i


    'size an array to write out to the sheet

    ReDim aOutput(1 To colUnique.Count, 1 To 1)


    'Loop through the collection and fill the output array

    For i = 1 To colUnique.Count

        aOutput(i, 1) = colUnique.Item(i)

    Next i


    'Write the unique values to column B

    Sheet1.Range("B2").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput


End Sub

Code function để sử dụng cho nhiều trường hợp cần lọc duy nhất.

Public Function LocDuyNhat(Rng As Range)
    Dim vaData As Variant
    Dim colUnique As Collection
    Dim aOutput() As Variant
    Dim i As Long
    
    'Lay du lieu can loc dua vao mang

    vaData = Rng.Value

    'Create a new collection

    Set colUnique = New Collection
   
    'Loop through the data

    For i = LBound(vaData, 1) To UBound(vaData, 1)

        'Collections can't have duplicate keys, so try to

        'add each item to the collection ignoring errors.

        'Only unique items will be added

        On Error Resume Next

            colUnique.Add vaData(i, 1), CStr(vaData(i, 1))

        On Error GoTo 0

    Next i

    'size an array to write out to the sheet

    ReDim aOutput(1 To colUnique.Count, 1 To 1)

    'Loop through the collection and fill the output array

    For i = 1 To colUnique.Count

        aOutput(i, 1) = colUnique.Item(i)

    Next i

    ' Trả giá trị lọc được về

    LocDuyNhat = aOutput()
    
End Function

Code gọi function và xuất nó ra cột để sử dụng

' Khai báo biến aOutput để lưu mảng trả về để tiện cho việc sử dụng

Dim LuuDS() As Variant

' Gọi hàm (function) và truyền dữ liệu vào để tìm

LuuDS= LocDuyNhat(Sheet2.Range("F5:F1000"))

' xuất danh sách đã lọc ra cột D bắt đầu từ D5

Sheet11.Range("D5").Resize(UBound(LuuDS, 1), UBound(LuuDS, 2)).Value = LuuDS