XÁC ĐỊNH GIÁ TRỊ ĐẶC BIỆT TRONG MẢNG HAY TRONG MỘT DẢI Ô

Bạn đã bao giờ chỉ thao tác với dữ liệu đặc biệt trong một dải ô? Nếu dữ liệu của bạn có dạng một cơ sở dữ liệu, thì bạn có thể sử dụng lệnh Advanced Filter để xuất các dữ liệu đặc biệt từ một cột. Nhưng nếu dữ liệu của bạn trải dài trên nhiều cột, Advanced Filter sẽ không chạy. Và Advanced Filter sẽ chẳng giúp ích gì nếu dữ liệu của bạn nằm trong mảng VBA.

Trong văn bản này, tôi trình bày một tính năng VBA – tính năng này chấp nhận hoặc đối tượng là một ô hay dải ô trong Excel hoặc mảng VBA. Tính năng trả về hoặc:

Một mảng khác chỉ gồm các dữ liệu đặc biệt trong mảng hay dải ô được nhấp vào (hay)
Một giá trị duy nhất: số dữ liệu đặc biệt trong mảng hay dải ô được nhập vào.

Đây là cấu trúc cho tính năng Uniqueltems (nó được liệt kê ở cuối văn bản này):

UniqueItems(ArrayIn, Count)

ArrayIn: đối tượng là một vùng ô, hay một mảng
Count: (Không bắt buộc) Nếu là True hay bỏ trống, tính năng sẽ trả về một giá trị duy nhất – số dữ liệu đặc biệt trong ArrayIn. Nếu là False, thì tính năng sẽ trả về một mảng gồm các dữ liệu đặc biệt trong ArrayIn.

VÍ DỤ 1

Thủ tục con dưới đây cho thấy Uniqueltems. Đoạn chương trình tạo ra 100 số nguyên ngẫu nhiên và lưu chúng trong một mảng. Mảng này sau đó được truyền cho tính năng Uniqueltems và một hộp tin nhắn hiển thị số số nguyên đặc biệt trong mảng. Con số có thể khác nhau mỗi khi bạn chạy đoạn chương trình.

Sub Test1()
    Dim z(1 To 100)
    For i = 1 To 100
        z(i) = Int(Rnd() * 100)
    Next i
    MsgBox UniqueItems(z, True)
End Sub
VÍ DỤ 2
Thủ tục con dưới đây đếm các dữ liệu chung trong hai trang tính. Nó tạo ra hai mảng. Mảng 1 
gồm các dữ liệu đặc biệt trong dải ô A1:A16; Mảng 2 gồm các dữ liệu đặc biệt trong dải ô 
B1:B16. Một vòng lặp được lồng vào đếm số dữ liệu có trong hai dải ô.

Sub Test2()
    Set Range1 = Sheets("Sheet1").Range("A1:A16")
    Set Range2 = Sheets("Sheet1").Range("B1:B16")
    Array1 = UniqueItems(Range1, False)
    Array2 = UniqueItems(Range2, False)
    CommonCount = 0
    For i = LBound(Array1) To UBound(Array1)
        For j = LBound(Array2) To UBound(Array2)
            If Array1(i) = Array2(j) Then _
              CommonCount = CommonCount + 1
        Next j
    Next i
    MsgBox CommonCount
End Sub
VÍ DỤ 3
Tính năng Uniqueltems cũng có thể được dùng trong công thức trang tính. Công thức dưới đây
trả về số dữ liệu đặc biệt trong một dải ô:

=UniqueItems(A1:D21)
VÍ DỤ 4
Để hiển thị các dữ liệu đặc biệt trong một dải ô, bạn phải nhập công thức mảng vào dải ô (sử
dụng Ctrl+Shift+Enter). Kết quả của tính năng Uniqueltems là một mảng ngang. Nếu bạn muốn hiển
các dữ liệu đặc biệt trong một cột, bạn có thể sử dụng tính năng TRANSPOSE. Công thức dưới đây
(được nhập giống như khi nhập công thức mảng vào một dải ô theo chiều dọc) trả về các dữ liệu 
đặc biệt trong dải ô A1:D21.

=TRANSPOSE(UniqueItems(A1:D21,FALSE))
MÃ

Option Base 1

Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
'   Accepts an array or range as input
'   If Count = True or is missing, the function returns the number of unique elements
'   If Count = False, the function returns a variant array of unique elements
    Dim Unique() As Variant ' array that holds the unique items
    Dim Element As Variant
    Dim i As Integer
    Dim FoundMatch As Boolean
'   If 2nd argument is missing, assign default value
    If IsMissing(Count) Then Count = True
'   Counter for number of unique elements
    NumUnique = 0
'   Loop thru the input array
    For Each Element In ArrayIn
        FoundMatch = False
'       Has item been added yet?
        For i = 1 To NumUnique
            If Element = Unique(i) Then
                FoundMatch = True
                Exit For '(exit loop)
            End If
        Next i
AddItem:
'       If not in list, add the item to unique list
        If Not FoundMatch And Not IsEmpty(Element) Then
            NumUnique = NumUnique + 1
            ReDim Preserve Unique(NumUnique)
            Unique(NumUnique) = Element
        End If
    Next Element
'   Assign a value to the function
    If Count Then UniqueItems = NumUnique Else UniqueItems = Unique
End Function
(Gửi lời cảm ơn đến Peter Atherton vì đã đề nghị phương pháp này nhằm tránh chuyển giá trị 
rỗng thành giá trị 0)