- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Từ hàm lọc duy nhất mảng 2 chiều của Thầy ndu96081631 dưới đây, tôi rất cảm ơn Thầy vì đã giải quyết được rất nhiều trường hợp lọc duy nhất trong mảng:
Tuy nhiên một nhu cầu cũng rất cần thiết và chính đáng là có thể ta lọc ở cột này, nhưng nhận giá trị ở một hoặc một nhóm cột liên tục cần thiết, không nhất thiết lọc cả mảng rồi nhận giá trị của tất cả các cột đã lọc.
Vì thế, tôi xin mạn phép Thầy ndu96081631 thêm chức năng lựa chọn 1 hoặc một nhóm cột (liên tục) trong mảng đã lọc:
Thay vì ghi ra công thức phải bắt buộc ghi đầy đủ các lựa chọn, thì tôi chỉ bắt buộc ghi trong công thức vùng mảng cần lọc, còn những mục khác nếu có thì điền vào.
Cấu trúc và cách sử dụng hàm:
1) Nếu chỉ lọc duy nhất ở cột đầu tiên và xuất ra tất cả các giá trị đã lọc thì công thức chỉ là:
2) Các cách lọc khác như hàm Unique2DArray (của Thầy ndu96081631)
3) Chọn lọc cột đã lọc trong mảng:
- Nếu lấy 1 cột (vd cột 8) thì công thức:
- Nếu chỉ trích nhóm cột từ 4 đến 6 thì công thức sẽ là:
- Nhưng nếu ta đão cột từ 7 về 3 thì ta làm như sau:
Tôi đã ghi cách sử dụng rất rõ trong file, các bạn tham khảo nhé!
Trong chừng mực kiến thức có hạn, nếu có lỗi phát sinh hoặc có những cải tiến mới, xin các bạn vui lòng góp ý và hoàn thiện để nó trở nên tiện ích hơn.
Trân trọng.
PHP:
Option Explicit
''***************************************************************************''
'' GiaiphapExcel.com ********************************************************''
'' Ham Unique2DArray - Tac gia: ndu96081631 *********************************''
Function Unique2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal HasTitle As Boolean)
Dim TmpArr, KeyArr, Tmp, i As Long, j As Long, Arr
On Error Resume Next
TmpArr = sArray
ColIndex = ColIndex + LBound(TmpArr, 2) - 1
With CreateObject("Scripting.Dictionary")
For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
Tmp = TmpArr(i, ColIndex)
If Not .Exists(Tmp) And Tmp <> "" Then .Add Tmp, i
Next
If .Count Then
KeyArr = .Keys
ReDim Arr(LBound(KeyArr) + LBound(TmpArr, 1) To UBound(KeyArr) - HasTitle + LBound(TmpArr, 1), LBound(TmpArr, 2) To UBound(TmpArr, 2))
For i = LBound(KeyArr) To UBound(KeyArr)
For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
Arr(i - HasTitle + LBound(TmpArr, 1), j) = TmpArr(.Item(KeyArr(i)), j)
Next
Next
If HasTitle Then
For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
Arr(LBound(TmpArr, 1), j) = TmpArr(LBound(TmpArr, 1), j)
Next
End If
Unique2DArray = Arr
End If
End With
End FunctionTuy nhiên một nhu cầu cũng rất cần thiết và chính đáng là có thể ta lọc ở cột này, nhưng nhận giá trị ở một hoặc một nhóm cột liên tục cần thiết, không nhất thiết lọc cả mảng rồi nhận giá trị của tất cả các cột đã lọc.
Vì thế, tôi xin mạn phép Thầy ndu96081631 thêm chức năng lựa chọn 1 hoặc một nhóm cột (liên tục) trong mảng đã lọc:
Mã:
Function NewUnique2DArray(ByVal SrcArray As Variant, _
Optional ByVal ColIndex As Variant, _
Optional ByVal HasTitle As Variant, _
Optional ByVal startCol As Variant, _
Optional ByVal endCol As Variant)
If IsArray(SrcArray) Then
Dim TmpArr, KeyArr, Arr, Tmp, r As Long, c As Long
Dim i As Long, j As Long, SCol As Long, ECol As Long
Dim Upset As Boolean: Upset = False
TmpArr = SrcArray
i = UBound(TmpArr, 2): j = LBound(TmpArr, 2)
Select Case HasTitle
Case True: HasTitle = True
Case Else: HasTitle = False
End Select
ColIndex = Abs(Int(Val(ColIndex)))
If ColIndex > i Or ColIndex = 0 Then ColIndex = 1
ColIndex = ColIndex + j - 1
startCol = Abs(Int(Val(startCol)))
If startCol > i Then startCol = i
endCol = Abs(Int(Val(endCol)))
If endCol > i Then endCol = i
If startCol = 0 And endCol = 0 Then
startCol = j: endCol = i
SCol = j: ECol = i
ElseIf startCol = 0 And endCol = 1 Then
startCol = j: SCol = j: ECol = j
ElseIf startCol = 0 And endCol > 1 Then
startCol = j: SCol = j
ECol = endCol - j + 1
ElseIf startCol > 0 And endCol = 0 Then
endCol = startCol: SCol = j: ECol = j
Else
If startCol > endCol Then
Upset = True
SCol = endCol: ECol = startCol
startCol = SCol: endCol = ECol
End If
SCol = j: ECol = endCol - startCol + 1
End If
Dim Handle As Long: Handle = Upset * (endCol + startCol - j + 1)
With CreateObject("Scripting.Dictionary")
For r = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
Tmp = TmpArr(r, ColIndex)
If Not .Exists(Tmp) And Tmp <> "" Then .Add Tmp, r
Next
If .Count Then
KeyArr = .Keys
Dim F As Long, L As Long
F = LBound(KeyArr) + LBound(TmpArr, 1)
L = UBound(KeyArr) - HasTitle + LBound(TmpArr, 1)
ReDim Arr(F To L, startCol To endCol)
For r = LBound(KeyArr) To UBound(KeyArr)
For c = startCol To endCol
Arr(r - HasTitle + LBound(TmpArr, 1), c) = TmpArr(.Item(KeyArr(r)), Abs(c + Handle))
Next
Next
If HasTitle Then
For c = startCol To endCol
Arr(LBound(TmpArr, 1), c) = TmpArr(LBound(TmpArr, 1), Abs(c + Handle))
Next
End If
ReDim Preserve Arr(F To L, SCol To ECol)
NewUnique2DArray = Arr
End If
End With
Erase Arr, TmpArr, KeyArr
Else
NewUnique2DArray = SrcArray
End If
End FunctionThay vì ghi ra công thức phải bắt buộc ghi đầy đủ các lựa chọn, thì tôi chỉ bắt buộc ghi trong công thức vùng mảng cần lọc, còn những mục khác nếu có thì điền vào.
Cấu trúc và cách sử dụng hàm:
1) Nếu chỉ lọc duy nhất ở cột đầu tiên và xuất ra tất cả các giá trị đã lọc thì công thức chỉ là:
PHP:
= NewUnique2DArray(SrcArray)2) Các cách lọc khác như hàm Unique2DArray (của Thầy ndu96081631)
3) Chọn lọc cột đã lọc trong mảng:
- Nếu lấy 1 cột (vd cột 8) thì công thức:
PHP:
= NewUnique2DArray(A1:J83, 3, True, 8)- Nếu chỉ trích nhóm cột từ 4 đến 6 thì công thức sẽ là:
PHP:
= NewUnique2DArray(A1:J83, 3, TRUE, 4, 6)- Nhưng nếu ta đão cột từ 7 về 3 thì ta làm như sau:
PHP:
= NewUnique2DArray(A1:J83, 3, TRUE, 7, 3)Tôi đã ghi cách sử dụng rất rõ trong file, các bạn tham khảo nhé!
Trong chừng mực kiến thức có hạn, nếu có lỗi phát sinh hoặc có những cải tiến mới, xin các bạn vui lòng góp ý và hoàn thiện để nó trở nên tiện ích hơn.
Trân trọng.
