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

Hoàng Trọng Nghĩa · 4/4/13

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

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:

ndu96081631 đã viết:
Hoàng Trọng Nghĩa đã viết:

Em không nghĩ trên Access nó lại cần dùng hàm này, bởi nó có công cụ GROUP BY, DISTINCT sẽ giúp lọc nhanh chóng.

Nhấp chuột vào đây để mở rộng...

Sao lại không cần!
Chẳng phải hàm tôi viết tham chiếu đến 1 Array sao? Mà Array thì hoạt động ở môi trường nào mà chẳng được, chẳng hạn 1 list nằm trên ListBox của form
-----------
Đế có thời gian tôi sẽ cải tiến lại hàm này không phải như cách mà nghĩa đang làm đâu ---> Nó sẽ dựa trên cách vận hành của Advanced Filter ấy, tức là lọc gì đó trên 1 CSDL và trích ra bao nhiêu field tù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, [Cot_can_loc], [Tieu_de_cot], [Cac_cot_hien_thi], [Phan_biet_HOA_Thuong])

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) [Cot_can_loc]: 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) [Tieu_de_cot]: 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) [Cac_cot_hien_thi]: 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) [Phan_biet_HOA_Thuong]: 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:
**************************************************************

PHP:

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:

PHP:

Sub Test1()
    'Header = xlYes
    Dim Arr As Variant
    Arr = Unique2D(Sheet1.[A1:G42], 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

Hoàng Trọng Nghĩa · 4/4/13

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.

Hoàng Trọng Nghĩa · 7/6/13

Tôi đã cải tiến một số tính năng, bẫy lỗi cũng như tăng tốc, các bạn tải file về tại bài 1 để tham khảo.

File mới có tên: NewUnique2D_V.2.1.xls

huuthanhxd · 29/6/13

Hoàng Trọng Nghĩa đã viết:
Tôi đã cải tiến một số tính năng, bẫy lỗi cũng như tăng tốc, các bạn tải file về tại bài 1 để tham khảo.

File mới có tên: NewUnique2D_V.2.1.xls

Bạn ơi, mình đã download về và thử dụng với cú pháp hàm:
=unique2d(A1:A20;1;"1") để lọc ra trường cột mã khách hàng nhưng báo lỗi !NAME
Mong bạn hướng dẫn thêm.
Xin chân thành cảm ơn!

hieuxd · 29/6/13

Anh nghĩa ơi anh có thể nhập hàm lọc với đầy đủ các đối số của hàm xuống bên dưới không
Em tải File của anh chưa nhìn thấy ví dụ dùng hàm này

Hoàng Trọng Nghĩa · 26/7/13

huuthanhxd đã viết:
Bạn ơi, mình đã download về và thử dụng với cú pháp hàm:
=unique2d(A1:A20;1;"1") để lọc ra trường cột mã khách hàng nhưng báo lỗi !NAME
Mong bạn hướng dẫn thêm.
Xin chân thành cảm ơn!

Hàm này chỉ dùng trong thủ tục macro thôi bạn ơi, không thực hiện trên sheet được đâu. Khi một hàm tự tạo mà dùng trên sheet bị hiển thị lỗi Name thì do bạn chưa Enable Macro thôi nha bạn.

Hoàng Trọng Nghĩa · 26/7/13

hieuxd đã viết:
Anh Nghĩa ơi anh có thể nhập hàm lọc với đầy đủ các đối số của hàm xuống bên dưới không
Em tải File của anh chưa nhìn thấy ví dụ dùng hàm này

Với file NewUnique2D_V.2.1.xls bạn tải về và thử với thủ tục sau:

Mã:

Sub Test3()
    Dim Arr As Variant
    
    Arr = UNIQUE2D(Expression:=Sheet1.[A1:G42], _
                   ColumnUnique:=6, _
                   Header:=xlYes, _
                   ColumnDisplay:="1-3,5-7,4", _
                   IsUCase:=True)
                   
    If IsArray(Arr) Then
        Sheet2.Cells.Clear
        Sheet2.Range("A1").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
    End If
End Sub

Diễn giải như sau:

Expression: Vùng hoặc mảng cần lọc (Sheet1.[A1:G42])

ColumnUnique: Cột cần lọc (cột 6)

Header: Bao gồm tiêu đề hay không, nếu có tiêu đề (xlYes) thì Expression phải bao gồm hàng tiêu đề.

ColumnDisplay: Dạng chuỗi, sau khi lọc, kết quả cần xuất ra các số cột cần thiết, nếu không có sự lựa chọn nào thì mặc nhiên nó sẽ xuất ra tất cả các cột mà Vùng hoặc Mảng ban đầu có.

IsUCase: Phân biệt chữ HOA, Thường. Nếu ở cột 6, bạn để "THÁNG" rồi "Tháng" rồi "tháng" và bạn chọn là True thì nó sẽ hiển thị tất cả những chữ này, còn False thì chỉ hiển thị 1 giá trị đầu tiên nó gặp.

Không biết tôi diễn giải như thế có đúng ý bạn không nhỉ?

stormlove · 9/6/17

thanks all

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

Người dùng đang xem chủ đề này

Hoàng Trọng Nghĩa

Chuyên gia GPE

File đính kèm

Hoàng Trọng Nghĩa

Chuyên gia GPE

Hoàng Trọng Nghĩa

Chuyên gia GPE

huuthanhxd

Thành viên mới

hieuxd

Thành viên tích cực

Hoàng Trọng Nghĩa

Chuyên gia GPE

Hoàng Trọng Nghĩa

Chuyên gia GPE

stormlove

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian