Tặng hàm [ Unique2D ] tùy chọn cột hiển thị sau khi lọc duy nhất.

Hàm được cải tiến từ bài

[URL='https://www.giaiphapexcel.com/forum/showthread.php?73342-Th%C3%AAm-l%E1%BB%B1a-ch%E1%BB%8Dn-cho-h%C3%A0m-Unique2DArray-c%E1%BB%A7a-Th%E1%BA%A7y-ndu96081631&p=448661#post448661']Thêm lựa chọn cho hàm Unique2DArray của Thầy ndu96081631

và theo ý tưởng của bài viết này:

Vì cái mục màu đỏ này: "trích ra bao nhiêu field tùy ý" nên tôi đã quyết định viết về nó một cách tổng quát nhất.

Khi sử dụng hàm này, công thức sẽ như sau:

Cong_thuc = Unique2D(Mang_2_chieu, , , , )

Mục đích:

Lọc duy nhất một mảng hai chiều, xuất ra các cột cần thiết.

Diễn giải:

1) Mang_2_chieu: Bạn bắt buộc phải nhập vào trong Hàm một vùng (range) hoặc một mảng (array) 2 chiều cần lọc duy nhất.

Các mục dưới đây không cần thêm vào hàm nếu thật sự không cần thiết:

2) : Bạn chọn lựa một cột cần lọc duy nhất (bằng số), nếu không chọn cột nào, mặc nhiên khi thực hiện nó sẽ chọn cột đầu tiên trong mảng hai chiều.

3) : Trong vùng mảng của bạn nếu có tiêu đề cột và bạn muốn dữ liệu sau khi lọc vẫn giữ lại tiêu đề thì bạn chọn là xlYes, còn không có tiêu đề thì bạn chọn là xlNo hoặc không cần gõ vào vì mặc định nó đã là xlNo rồi.

4) : Trong vùng mảng cần lọc, không nhất thiết ta phải chọn toàn bộ các cột sau khi lọc, vì thế tôi đã cải tiến hàm này bằng một thủ tục xử lý các cột cần hiển thị ở dạng chuỗi và chuyển chúng thành mảng một chiều.

Cách nhập như sau: "1, 3, 4, 6-8, 9-5, 10, 15"

Với cột lẻ loi, bạn chỉ thêm dấu phẩy, cột liên tiếp bạn dùng dấu gạch nối (–), với các cột liên tiếp, các bạn có thể cho hiển thị từ nhỏ đến lớn hoặc từ lớn đến nhỏ.

Lưu ý: Tất cả số cột cần hiển thị này được đặt trong dấu ngoặc kép ("…") ở hai đầu.

Nếu để trống mục này, thì mặc nhiên sau khi lọc, mảng có bao nhiêu cột thì sẽ hiển thị bấy nhiêu cột.

5) : Có những dữ liệu có viết HOA viết thường, nếu bắt buộc phải lọc có phân biệt thì các bạn nhập là TRUE, còn không thì FALSE. Nếu để trống xem như là FALSE.

**************************************************************
Sau đây là hàm Unique2D:
**************************************************************

Function Unique2D(ByVal Expression As Variant, _
Optional ByVal ColumnUnique As Long, _
Optional ByVal Header As HeaderType = xlNo, _
Optional ByVal ColumnDisplay As String, _
Optional ByVal IsUCase As Boolean = False) As Variant
Dim SourceArray As Variant
SourceArray = Expression
If Not IsArray(SourceArray) Then Exit Function
Dim Lcol As Long, Ucol As Long
Lcol = LBound(SourceArray, 2)
Ucol = UBound(SourceArray, 2)
If ColumnUnique = 0 Then
ColumnUnique = Lcol
Else
If ColumnUnique > Ucol Or ColumnUnique < Lcol Then _
GoTo Error9
End If
Call ColumnDisplayHandler(ColumnDisplay, Lcol, Ucol)
If IsExitFunction Then _
GoTo Error9
Dim Lrow As Long, Urow As Long, UnqCol As Long, UnqRow As Long, _
KeyArr As Variant, RowItem As Variant
Lrow = LBound(SourceArray, 1) – Header
Urow = UBound(SourceArray, 1)
With CreateObject("Scripting.Dictionary")
.CompareMode = IIf(IsUCase, vbBinaryCompare, vbTextCompare) '0 & 1
For UnqRow = Lrow To Urow
RowItem = SourceArray(UnqRow, ColumnUnique)
If Not .Exists(RowItem) And RowItem <> "" Then .Add RowItem, UnqRow
Next
If .Count Then
Dim UnqArr As Variant
KeyArr = .Keys
Urow = UBound(KeyArr): Ucol = UBound(ColumnArr)
If Header Then
Lrow = Lrow – 1: Urow = Urow + 1
ReDim UnqArr(1 To Urow + 1, 1 To Ucol)
For UnqCol = 1 To Ucol
UnqArr(1, UnqCol) = SourceArray(Lrow, ColumnArr(UnqCol))
Next
For UnqRow = 1 To Urow
For UnqCol = 1 To Ucol
UnqArr(UnqRow + 1, UnqCol) = SourceArray(.Item(KeyArr(UnqRow – 1)), ColumnArr(UnqCol))
Next
Next
Else
ReDim UnqArr(1 To Urow + 1, 1 To Ucol)
For UnqRow = 0 To Urow
For UnqCol = 1 To Ucol
UnqArr(UnqRow + 1, UnqCol) = SourceArray(.Item(KeyArr(UnqRow)), ColumnArr(UnqCol))
Next
Next
End If
.RemoveAll
Unique2D = UnqArr
Erase KeyArr, UnqArr
End If
End With
Erase SourceArray
Exit Function
Error9:
MsgBox "Check the function 'Unique2D'" & vbLf & vbLf & _
"(Careful with 'ColumnUnique' or 'ColumnDisplay').", _
vbExclamation, "Subscript out of range (Error 9)"
End Function

Đây là một trong những kiểu test của tôi:

Sub Test1()
'Header = xlYes
Dim Arr As Variant
Arr = Unique2D(Sheet1., 5, xlYes, "1-7, 1, 3, 5, 7-1, 2, 4, 6", False)
If IsArray(Arr) Then
Sheet2.Cells.Clear
Sheet2.Range("A1").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
End If
End Sub

TÔI ĐÃ KIỂM TRA CHO NHIỀU TRƯỜNG HỢP, HIỆN TẠI TÔI CHƯA PHÁT HIỆN RA LỖI, HY VỌNG CÁC BẠN TẢI FILE VỀ VÀ TEST NHIỀU KIỂU, NẾU CÓ PHÁT HIỆN LỖI XIN VUI LÒNG GỬI BÀI LÊN TOPIC NÀY ĐỂ TÔI HOÀN THIỆN HÀM TỐT HƠN.

===================================================================
Đã update một số tính năng bẫy lỗi, tăng tốc, các bạn tải file mới có tên NewUnique2D_V.2.1.xls
Cũng nói thêm, với Hàm này, lúc đầu tôi cũng đã thử dùng ParamArray để xử lý, thật ra cái biến này như một mảng 1 chiều, xử lý dễ dàng, tuy nhiên cái hạn chế của nó là không cho biến nào được quyền Optional cả, vì thế nếu một hàm mà nhiều biến và đôi khi không cần dùng tới mà luôn phải đề cập trong hàm thì trông nó cứ lê thê và khó kiểm soát nên tôi chuyển nó về dạng biến chuỗi rồi xử lý thành mảng một chiều cho tiện.

www.giaiphapexcel.com/diendan/threads/t%E1%BA%B7ng-h%C3%A0m-unique2d-t%C3%B9y-ch%E1%BB%8Dn-c%E1%BB%99t-hi%E1%BB%83n-th%E1%BB%8B-sau-khi-l%E1%BB%8Dc-duy-nh%E1%BA%A5t.79085/#post487840

Khóa học SprinGO phù hợp

Thiết kế Tổng đãi ngộ (Total Rewards) theo khung SHRM

Khóa học “Thiết kế Tổng phần thưởng (Total Reward) chuẩn khung SHRM” giúp bạn nắm vững toàn bộ hệ thống đãi ngộ theo chuẩn...

Xem khóa học