Thắc mắc về hàm UDF UniqueList

Hoàng Trọng Nghĩa · 28/8/11

PHP:

Function UniqueList(ParamArray sArray())
  Dim Item, TmpArr, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      TmpArr = SubArr
      If TypeName(TmpArr) <> "Variant()" Then
        If TmpArr <> "" Then .Add TmpArr, ""
      Else
        For Each Item In TmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
      End If
    Next
    UniqueList = .Keys
  End With
End Function

Nếu làm từ AdvancedFilter thì không nói gì:

PHP:

Sub TEST2()
  With Range([A2], [A65536].End(xlUp))
    .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    .Resize(, 7).Copy [J17]
  End With
  ActiveSheet.ShowAllData
End Sub

nhưng làm theo hàm UniqueList của Thầy ndu96081631 thì không thể thực hiện được.

Tôi làm thủ tục như sau:

PHP:

Sub TEST()
  Dim Arr1
  With Range([A3], [A65536].End(xlUp)).Resize(, 7)
    Arr1 = UniqueList(.Cells)
    [J17].Resize(UBound(Arr1, 1), 7).Value = WorksheetFunction.Transpose(Arr1)
  End With
End Sub

Kết quả ra hoàn toàn không như ý.

Xin hướng dẫn thủ tục sử dụng hàm này cho đúng.

Cám ơn rất nhiều!

ndu96081631 · 29/8/11

Xét về thuật toán thì bài này không khó. Cái khó là:
- Viết thành 1 UDF tổng quát
- Cho phép hoạt động trên mọi Array (Base 0 hoặc Base 1)
- Có thể gõ trực tiếp vào bảng tính như 1 hàm của Excel
-------------------------
"Bắt chước" y chang cách viết của hàm Filter2DArray:

PHP:

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 Function

Sư phụ ptm0412 dùng TRANSPOSE nên sẽ có lỗi xảy ra trong 1 số trường hợp, còn code ở trên thêm 1 vòng lập nữa để lấy kết quả duy nhất trước, sau đó mới nạp vào Array kết quả (không dùng TRANSPOSE) nên chắc chắn sẽ không có bất cứ lỗi nào
Ngoài ra, code ở trên còn cho phép bạn tùy chọn dữ liệu là CÓ TIÊU ĐỀ HOẶC KHÔNG CÓ TIÊU ĐỀ
Ví dụ code trích lọc không lấy tiêu đề:

Mã:

Sub Test2()
  Dim sArray, Arr, TG As Double
  TG = Timer
  sArray = Range(Sheet1.[A3], Sheet1.[A65536].End(xlUp)).Resize(, 7)
  Arr = Unique2DArray(sArray, 1, [COLOR=#ff0000][B]FALSE[/B][/COLOR])
  If IsArray(Arr) Then Sheet1.Range("J2").Resize(UBound(Arr, 1), 7).Value = Arr
  MsgBox Format(Timer - TG, "0.000000")
End Sub

Và code trích lọc lấy luôn tiêu đề:

Mã:

Sub Test2()
  Dim sArray, Arr, TG As Double
  TG = Timer
  sArray = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7)
  Arr = Unique2DArray(sArray, 1, [COLOR=#ff0000][B]TRUE[/B][/COLOR])
  If IsArray(Arr) Then Sheet1.Range("J1").Resize(UBound(Arr, 1), 7).Value = Arr
  MsgBox Format(Timer - TG, "0.000000")
End Sub

Đã thử nghiệm với dữ liệu 40,000 dòng, ra kết quả trong khoảng 1s

Hoàng Trọng Nghĩa · 29/8/11

Xin cảm ơn Thầy NDU rất nhiều, Thầy và Sư phụ PTM thật nhiệt tình và kiến thức thật uyên thâm. Bản thân em tư duy về mãng còn hạn chế quá nên không thấy phát huy được tí nào hết. Thôi đành ứng dụng của các Thầy vậy (chứ ứng dụng của mình chắc chạy cả phút mới ra kết quả, mà chưa chắc đã là đúng nữa!)

Xin cảm ơn 2 Thầy đã hướng dẫn ạ!

vodoi2x · 29/8/11

minhthien321 đã viết:
Xin cảm ơn Thầy NDU rất nhiều, Thầy và Sư phụ PTM thật nhiệt tình và kiến thức thật uyên thâm. Bản thân em tư duy về mãng còn hạn chế quá nên không thấy phát huy được tí nào hết. Thôi đành ứng dụng của các Thầy vậy (chứ ứng dụng của mình chắc chạy cả phút mới ra kết quả, mà chưa chắc đã là đúng nữa!)

Xin cảm ơn 2 Thầy đã hướng dẫn ạ!

Chú ý tôi thử thấy cả 2 cái trên của ndu và ptm đều hoạt động sai khác so với Advance filter unique only nhé

Advance filter cho phép lọc duy nhất cho cả hàng (unique records)

Còn Các Sub / Function trên chỉ lọc duy nhất cho 1 cột và copy các cột đi theo,

bạn phải xem lại cận thận phạm vi ứng dụng?

ndu96081631 · 29/8/11

vodoi2x đã viết:
Chú ý tôi thử thấy cả 2 cái trên của ndu và ptm đều hoạt động sai khác so với Advance filter unique only nhé

Advance filter cho phép lọc duy nhất cho cả hàng (unique records)

Còn Các Sub / Function trên chỉ lọc duy nhất cho 1 cột và copy các cột đi theo,

bạn phải xem lại cận thận phạm vi ứng dụng?

Thì người ta yêu cầu như vậy cơ mà
Còn muốn Unique nguyên hàng thì... cũng chẳng khó tí nào (gần như y chang vậy)
Tóm lại là: VIẾT CODE THEO YÊU CẦU CỦA NGƯỜI DÙNG

ptm0412 · 29/8/11

vodoi2x đã viết:
Chú ý tôi thử thấy cả 2 cái trên của ndu và ptm đều hoạt động sai khác so với Advance filter unique only nhé

Advance filter cho phép lọc duy nhất cho cả hàng (unique records)

Còn Các Sub / Function trên chỉ lọc duy nhất cho 1 cột và copy các cột đi theo,

bạn phải xem lại cận thận phạm vi ứng dụng?

Phạm vi ứng dụng thì xem trong file yêu cầu bài 1:
Lọc DS duy nhất 1 cột và các cột khác đi theo.
Advanced Filter tác giả đã thực hiện cũng chỉ 1 cột.

Hoàng Trọng Nghĩa · 29/8/11

vodoi2x đã viết:
Chú ý tôi thử thấy cả 2 cái trên của ndu và ptm đều hoạt động sai khác so với Advance filter unique only nhé

Advance filter cho phép lọc duy nhất cho cả hàng (unique records)

Còn Các Sub / Function trên chỉ lọc duy nhất cho 1 cột và copy các cột đi theo,

bạn phải xem lại cận thận phạm vi ứng dụng?

Không đâu, trong Excel nó cũng Unique tại cột 1 thôi, các số liệu khác ăn theo cái cột đã unique. Cái này em đã kiểm tra rồi ạ.

Các hàm tự tạo vừa rồi hay hơn thằng Excel đấy chứ! Vã lại nếu mỗi cái mỗi Unique thì chết! Lộn xộn mất thôi.

vodoi2x · 29/8/11

minhthien321 đã viết:
Không đâu, trong Excel nó cũng Unique tại cột 1 thôi, các số liệu khác ăn theo cái cột đã unique. Cái này em đã kiểm tra rồi ạ.

Các hàm tự tạo vừa rồi hay hơn thằng Excel đấy chứ! Vã lại nếu mỗi cái mỗi Unique thì chết! Lộn xộn mất thôi.

Không phải, đó là trường hợp bạn chưa lấy số liệu sự khác biệt đó

Advanced Fillter cho phép Records only -- tức là duy nhất cho tất cả các cột (bạn thử lại với trường hợp các dòng có cột 1 mã giống nhau (chẳng hạn) nhưng các cột khác khác nhau, thì sẽ thấy rõ ngay.
Không phải, đó là trường hợp bạn chưa lấy số liệu sự khác biệt đó

ndu96081631 · 29/8/11

minhthien321 đã viết:
Không đâu, trong Excel nó cũng Unique tại cột 1 thôi, các số liệu khác ăn theo cái cột đã unique. Cái này em đã kiểm tra rồi ạ.

Các hàm tự tạo vừa rồi hay hơn thằng Excel đấy chứ! Vã lại nếu mỗi cái mỗi Unique thì chết! Lộn xộn mất thôi.

1 cột hay nhiều cột là do bạn quét chọn List Range thôi
- Quét chọn List Range là 1 cột thì nó Unique 1 cột
- Quét chọn List Range nhiều cột thì nó Unique nhiều cột

Hoàng Trọng Nghĩa · 29/8/11

Không biết có thể cải tiến ngoài việc chọn Resize giới hạn số cột khi copy, có thể Offset mãng trong Dic được không? Bởi mỗi lần mình giới hạn (bỏ qua) cột nào đó thì cột kế tiếp để copy mình lại sử dụng Hàm lại. Tương tự với Filter2DArray. Tức là copy bất kỳ cột nào trong mãng chứ không phải là từ trái qua phải.

ptm0412 · 29/8/11

Sư phụ ptm0412 dùng TRANSPOSE nên sẽ có lỗi xảy ra trong 1 số trường hợp, còn code ở trên thêm 1 vòng lập nữa để lấy kết quả duy nhất trước, sau đó mới nạp vào Array kết quả (không dùng TRANSPOSE) nên chắc chắn sẽ không có bất cứ lỗi nào

Cho tới giờ vẫn chưa tìm ra trường hợp lỗi nào của Transpose, kể cả test với 50 ngàn dòng mà chỉ 10 Unique Name.

code ở trên còn cho phép bạn tùy chọn dữ liệu là CÓ TIÊU ĐỀ HOẶC KHÔNG CÓ TIÊU ĐỀ

Tham số này không cần thiết, vì thông thường dữ liệu không trùng với tiêu đề. Vậy bản thân tiêu đề cũng là 1 trong danh sách không trùng. Chỉ cần trùm luôn dòng tiêu đề vào range sArray là xong.

ndu96081631 · 29/8/11

ptm0412 đã viết:
Cho tới giờ vẫn chưa tìm ra trường hợp lỗi nào của Transpose, kể cả test với 50 ngàn dòng mà chỉ 10 Unique Name.

Cái này có đấy sư phụ à (em đã từng gặp)
Sư phụ có thể search google sẽ thấy rất nhiều người hỏi về vấn đề giới hạn của TRANSPOSE

ptm0412 đã viết:
Tham số này không cần thiết, vì thông thường dữ liệu không trùng với tiêu đề. Vậy bản thân tiêu đề cũng là 1 trong danh sách không trùng. Chỉ cần trùm luôn dòng tiêu đề vào range sArray là xong.

Cần chứ sư phụ
Chẳng hạn có người ta dùng Number để làm tiêu đề... Vậy trong phần nội dung sẽ không chắc dữ liệu sẽ luôn không trùng với tiêu đề (cũng vì thế mà chức năng Remove Duplicate của Excel 2007 cho phép người dùng chọn có tiêu đề hay không)
---------------------------

minhthien321 đã viết:
Không biết có thể cải tiến ngoài việc chọn Resize giới hạn số cột khi copy, có thể Offset mãng trong Dic được không? Bởi mỗi lần mình giới hạn (bỏ qua) cột nào đó thì cột kế tiếp để copy mình lại sử dụng Hàm lại. Tương tự với Filter2DArray. Tức là copy bất kỳ cột nào trong mãng chứ không phải là từ trái qua phải.

Nêu 1 ví dụ cụ thể, vì tôi không hiểu bạn nói gì cả

ptm0412 · 29/8/11

ndu96081631 đã viết:
Cái này có đấy sư phụ à (em đã từng gặp)
Sư phụ có thể search google sẽ thấy rất nhiều người hỏi về vấn đề giới hạn của TRANSPOSE

Có thể, nếu tích số số dòng nhân số cột, hoặc số cột vượt quá 1 giá trị giới hạn nào đó.

Cần chứ sư phụ
Chẳng hạn có người ta dùng Number để làm tiêu đề... Vậy trong phần nội dung sẽ không chắc dữ liệu sẽ luôn không trùng với tiêu đề (cũng vì thế mà chức năng Remove Duplicate của Excel 2007 cho phép người dùng chọn có tiêu đề hay không)

Ẹc ẹc, dùng Number làm tiêu đề là không đúng chuẩn CSDL. Kể cả vẽ đồ thị cũng bị lỗi huống chi làm việc khác.

Nêu 1 ví dụ cụ thể, vì tôi không hiểu bạn nói gì cả

Đại khái là sArray 7 cột, nhưng chỉ lấy kết quả 3 cột 1, 3 và 6. Và thứ tự không giống ban đầu chẳng hạn 1, 6, 3. Chuyện này nằm trong tầm tay.

To MinhThien:
Dic không phải là mảng đơn thuần, nó chỉ có 1 chiều. Không thể resize. Cái ta resize là mảng nguồn và mảng song song với Dic.
Và kể cả mảng thông thường, không có khái niệm Offset mảng.

ndu96081631 · 29/8/11

ptm0412 đã viết:
Đại khái là sArray 7 cột, nhưng chỉ lấy kết quả 3 cột 1, 3 và 6. Và thứ tự không giống ban đầu chẳng hạn 1, 6, 3. Chuyện này nằm trong tầm tay.
To MinhThien:
Dic không phải là mảng đơn thuần, nó chỉ có 1 chiều. Không thể resize. Cái ta resize là mảng nguồn và mảng song song với Dic.
Và kể cả mảng thông thường, không có khái niệm Offset mảng.

Vậy dễ nhất là cứ làm bình thường, ra được mảng kết quả, ta lại For... Next thêm 1 lần nữa để trích ra cái ta cần ---> Dễ hơn ăn khoai

Hoàng Trọng Nghĩa · 29/8/11

Cụ thể em làm cả 2 Hàm trong 1 File mà công việc em đang làm đây, 1 sheet thì cần Lọc duy nhất, nhưng không biết xử lý Hàm như thế nào; 1 sheet thì cần lọc không rỗng, xử lý được, nhưng lại double Hàm mới xong.

Giúp đỡ dùm em nhé! Cám ơn rất nhiều!

ptm0412 · 29/8/11

minhthien321 đã viết:
Cụ thể em làm cả 2 Hàm trong 1 File mà công việc em đang làm đây, 1 sheet thì cần Lọc duy nhất, nhưng không biết xử lý Hàm như thế nào

Làm theo ndu đi: Khoai luộc đây, 7 cột chỉ lấy 3 theo thứ tự 1, 6, 3:

Mã:

Sub Test()
...
Arr2 = Unique2DArray(...)
ReDim Arr3(1 to UBound(Arr2, 1), [COLOR=#ff0000][B]3[/B][/COLOR])
For i =1 to UBound(Arr2, 1)
  Arr3(i, 1) = Arr2(i, [COLOR=#ff0000]1[/COLOR])
  Arr3(i, 2) = Arr2(i, [COLOR=#ff0000]6[/COLOR]) 
  Arr3(i, 3) = Arr2(i, [COLOR=#ff0000]3[/COLOR])
Next
Ẹc ẹc
End Sub

ndu96081631 · 29/8/11

minhthien321 đã viết:
Cụ thể em làm cả 2 Hàm trong 1 File mà công việc em đang làm đây, 1 sheet thì cần Lọc duy nhất, nhưng không biết xử lý Hàm như thế nào; 1 sheet thì cần lọc không rỗng, xử lý được, nhưng lại double Hàm mới xong.

Giúp đỡ dùm em nhé! Cám ơn rất nhiều!

Trời...
Ví bạn có nói rằng:

còn TRỌNG LƯỢNG sẽ cộng dồn theo MÃ CHỦ HÀNG sau khi đã thực hiện các cột kia.

Vậy sao lại không dùng PivotTable mà dùng code chi cho mệt?
Nói thêm: Cho đến thời điểm này, tôi nghiên cứu Array và nhận xét rằng: Xử lý mảng có thể cho tốc độ nhanh hơn AutoFilter, Advanced Filter còn với PivotTalbe thì chưa có cách nào "thắng" nó được

Hoàng Trọng Nghĩa · 29/8/11

ndu96081631 đã viết:
Trời...
Ví bạn có nói rằng:

Vậy sao lại không dùng PivotTable mà dùng code chi cho mệt?
Nói thêm: Cho đến thời điểm này, tôi nghiên cứu Array và nhận xét rằng: Xử lý mảng có thể cho tốc độ nhanh hơn AutoFilter, Advanced Filter còn với PivotTalbe thì chưa có cách nào "thắng" nó được

Cột Trọng lượng em tự làm, chỉ cần trích lọc ra 3 cột kia thôi mà.

Cho em xin nói rõ rằng là, em đang học cách thức của các Hàm mà các Thầy làm, và em cũng biết rằng Pivot là nhanh, nhưng không nhất thiết dùng Pivot trong các biểu mẫu.

Em đã làm như vầy rồi, thật tình không hiểu nguyên lý của mảng nên em không biết sai chỗ nào mà cột J lại là không có, lại bắt đầu từ cột K:

PHP:

Sub Test2()
  Dim sArray, Arr, Arr2, i As Long
  
  sArray = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7)
  Arr = Unique2DArray(sArray, 1, True)
  
  ReDim Arr2(1 To UBound(Arr, 1), 3)
  
  For i = 1 To UBound(Arr, 1)
    Arr2(i, 1) = Arr(i, 1)
    Arr2(i, 2) = Arr(i, 6)
    Arr2(i, 3) = Arr(i, 3)
  Next
  
  If IsArray(Arr2) Then Sheet1.Range("J1").Resize(UBound(Arr2, 1), 3).Value = Arr2
End Sub

ndu96081631 · 29/8/11

minhthien321 đã viết:
Cột Trọng lượng em tự làm, chỉ cần trích lọc ra 3 cột kia thôi mà.

Cho em xin nói rõ rằng là, em đang học cách thức của các Hàm mà các Thầy làm, và em cũng biết rằng Pivot là nhanh, nhưng không nhất thiết dùng Pivot trong các biểu mẫu.

Em đã làm như vầy rồi, thật tình không hiểu nguyên lý của mảng nên em không biết sai chỗ nào mà cột J lại là không có, lại bắt đầu từ cột K:

PHP:

Sub Test2() Dim sArray, Arr, Arr2, i As Long sArray = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7) Arr = Unique2DArray(sArray, 1, True) ReDim Arr2(1 To UBound(Arr, 1), 3) For i = 1 To UBound(Arr, 1) Arr2(i, 1) = Arr(i, 1) Arr2(i, 2) = Arr(i, 6) Arr2(i, 3) = Arr(i, 3) Next If IsArray(Arr2) Then Sheet1.Range("J1").Resize(UBound(Arr2, 1), 3).Value = Arr2 End Sub

Sai chổ này: ReDim Arr2(1 To UBound(Arr, 1), 3)
Lý ra phải là: ReDim Arr2(1 To UBound(Arr, 1), 1 To 3)

Hoàng Trọng Nghĩa · 29/8/11

ndu96081631 đã viết:
Sai chổ này: ReDim Arr2(1 To UBound(Arr, 1), 3)
Lý ra phải là: ReDim Arr2(1 To UBound(Arr, 1), 1 To 3)

À, lợi dụng tại điểm này, mình cho cách khoảng 1 cột được không ta?

ptm0412 · 29/8/11

Lỗi chỗ này, do làm chay nên sót:
ReDim Arr2(1 To UBound(Arr, 1), 1 To 3)

Ngoài ra, do yêu cầu trong file dữ liệu thật, thì làm thử trong file này:

À, lợi dụng tại điểm này, mình cho cách khoảng 1 cột được không ta?

Mã:

 ReDim Arr2(1 To UBound(Arr, 1), 1 To [COLOR=#ff0000]4[/COLOR])
  For i = 1 To UBound(Arr, 1)
    Arr2(i, 1) = Arr(i, 1)
    Arr2(i, 2) = Arr(i, 6)
    Arr2(i, [COLOR=#ff0000]4[/COLOR]) = Arr(i, 3)
  Next

Tức là bỏ trống cột 3 của Arr2 để sum siếc trên sheet.
Quái, những cái này lại là quá căn bản chứ lị?

Và,
Đồng ý với ndu, hãy dùng Pivot table, nếu dùng VBA hãy dùng VBA với Pivot table.

Thắc mắc về hàm UDF UniqueList

Chuyên gia GPE

File đính kèm

Huyền thoại GPE

File đính kèm

Chuyên gia GPE

Nothing & Nothing

Huyền thoại GPE

Bad Excel Member

Chuyên gia GPE

Nothing & Nothing

Huyền thoại GPE

Chuyên gia GPE

Bad Excel Member

Huyền thoại GPE

Bad Excel Member

Huyền thoại GPE

Chuyên gia GPE

File đính kèm

Bad Excel Member

Huyền thoại GPE

Chuyên gia GPE

File đính kèm

Huyền thoại GPE

Chuyên gia GPE

Bad Excel Member

Đếm ngược thời gian