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

[Hoàng Trọng Nghĩa]

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ì:

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:

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!

 

[concogia]

Ẹc, 1 Dic chỉ có 1 key và 1 Item. Key thì đã dùng cho duy nhất, Item thì dùng để cộng dồn. Cộng dồn 1 field thôi chứ? Làm sao cộng dồn cho 2 field riêng rẽ?
Nghĩa là 2 cột cần 2 sumif chứ không phải sumif 2 cột vào 1.
Với lại, nếu dùng ArrSumCol, chưa biết trong đó có bao nhiêu phần tử à nha.

Được chứ Thầy, 1 Dic trong đó Keys là duy nhất & Items ....cũng duy nhất luôn - vì Item là số thứ tự của mảng kết quả-, 2 cột SumIf hay nhiều hơn cũng được mà Thầy - vì bao nhiêu SumIf cũng phải theo Key ==> lấy Item của Key đó ==> thứ tự của Mảng kết quả
Híc, Minhthien đâu zồi ???

 

[Hoàng Trọng Nghĩa]

Được chứ Thầy, 1 Dic trong đó Keys là duy nhất & Items ....cũng duy nhất luôn - vì Item là số thứ tự của mảng kết quả-, 2 cột SumIf hay nhiều hơn cũng được mà Thầy - vì bao nhiêu SumIf cũng phải theo Key ==> lấy Item của Key đó ==> thứ tự của Mảng kết quả
Híc, Minhthien đâu zồi ???

Dạ, em đang dựa cột mà nghe. Không dám thưa thốt gì hết!

 

[ptm0412]

À, đúng rồi, đánh dấu Array Kết Quả, và cộng vào Arr kết quả. Lúc nãy đọc code nhầm thành cộng dồn vào Item.
Zậy Cò làm hén?

 

[ptm0412]

Ẹc ẹc, đã làm xong. Test 50.000 dòng mất có 0,6 giây
Nói không bằng làm, làm không bằng cho xem:

Option Base 1
Sub UniqueAndSum(sArray, ArrCols, UniqueCol, ArrSumCols)
  Dim i, j, k, h As Long, iR As Long, Tmp, ReArr()
  On Error Resume Next
  ReDim Arr(1 To UBound(sArray, 1), 1 To UBound(ArrCols))
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(sArray, 1)
      If sArray(i, UniqueCol) <> "" Then
        Tmp = sArray(i, UniqueCol)
        If Not .Exists(Tmp) Then
          iR = iR + 1
          .Add Tmp, iR
          For j = 1 To UBound(ArrCols)
            Arr(iR, j) = sArray(i, ArrCols(j))
          Next j
        Else
            For j = 1 To UBound(ArrCols)
                For k = 1 To UBound(ArrSumCols)
                If ArrCols(j) = ArrSumCols(k) Then
                    Arr(.Item(Tmp), j) = Arr(.Item(Tmp), j) + sArray(i, ArrSumCols(k))
                End If
                Next k
            Next j
        End If
      End If
    Next i
  End With
  For h = 1 To UBound(ArrCols)
    Sheet2.Cells(1, h + 6) = Sheet1.Cells(1, ArrCols(h))
  Next h
  Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr
End Sub

Sub Test()
  Sheet2.Range("G1:K100").ClearContents
  Arr1 = Sheet1.Range("A2:G50001").Value
  t = Timer
  UniqueAndSum Arr1, Array(2, 1, 7, 6), 2, Array(6, 7)
  Sheet2.[f1] = Timer - t
End Sub

Cho xem không bằng cho thử: Tải file đính kèm về chạy thử.
Cái này sửa 1 chút xíu là thành Function luôn

 

[thanhlanh]

Ẹc ẹc, đã làm xong. Test 50.000 dòng mất có 0,6 giây
Nói không bằng làm, làm không bằng cho xem:


Cho xem không bằng cho thử: Tải file đính kèm về chạy thử.
Cái này sửa 1 chút xíu là thành Function luôn

Thử không bằng trả lời:
Làm cả hai cách luôn. Anh đúng là cao thủ võ lâm.
Máy cùi bắp của em cũng chỉ chạy mất 0,45s để xử lý 50k dòng dữ liệu
Biết vậy thôi chớ chưa thể tiêu hoá code ngay nên không thể "cãi lại" được, he he.

 

[Hoàng Trọng Nghĩa]

Ẹc ẹc, đã làm xong. Test 50.000 dòng mất có 0,6 giây
Nói không bằng làm, làm không bằng cho xem:
Cho xem không bằng cho thử: Tải file đính kèm về chạy thử.
Cái này sửa 1 chút xíu là thành Function luôn

Phải nói gì ta??? Quá tuyệt vời!

À nếu Sư phụ khai báo rõ ràng hơn sẽ cải thiện tốc độ đáng kể luôn!

Dim i As Long, j As Long, k As Long, h As Long, iR As Long

Tốc độ đo được là: 0.389999389648437

Cám ơn Sư phụ!

 

[thanhlanh]

Phải nói gì ta??? Quá tuyệt vời!

À nếu Sư phụ khai báo rõ ràng hơn sẽ cải thiện tốc độ đáng kể luôn!

Dim i As Long, j As Long, k As Long, h As Long, iR As Long

Tốc độ đo được là: 0.389999389648437

Cám ơn Sư phụ!

Ừ nhỉ, không những nhanh hơn mà hình như ổn định hơn, chạy thử 10 lần là biết, tốc độ của các lần chạy ít thay đổi.

 

[ndu96081631]

Ẹc ẹc, đã làm xong. Test 50.000 dòng mất có 0,6 giây
Nói không bằng làm, làm không bằng cho xem:
Cho xem không bằng cho thử: Tải file đính kèm về chạy thử.
Cái này sửa 1 chút xíu là thành Function luôn

Đến giai đoạn này thì thấy rõ ràng việc có thêm biến HasTitle nó lợi hại thế nào...
- Nếu HasTitle = True... thích hợp khi làm việc với Range
- Nếu HasTitle = False... thích hợp khi làm việc với ComboBox, ListBox
Tức không phải lúc nào người ta cũng muốn lấy tiêu đề và ngược lại
Ngoài ra, đã xác định dữ liệu nguồn là 1 Array (sArray) thì không thể biết trước nó thuộc Base 0 hay Base 1 (dữ liệu có thể nhận từ bất cứ nguồn nào mà)
Ẹc... Ẹc... cải tiến thêm bước này phải tốn thêm chút mồ hôi nữa mới xong!

 

[ptm0412]

Vụ HasTitle tạm khoan đã, bi giờ bổ sung chức năng chèn cột trống, mấy cột cũng được, liền nhau cũng được, cách quãng cũng được. (đừng bỏ đầu hoặc cuối, cũng được mà zô ziên lắm)

Muốn trống cột nào, thêm số 0 ở vị trí đó trong ArrCols

Thí dụ:

UniqueAndSum Arr1, Array(2, 1, 0, 7, 6), 2, Array(6, 7)
UniqueAndSum Arr1, Array(2, 1, 0, 0, 7, 6), 2, Array(6, 7)
UniqueAndSum Arr1, Array(2, 1, 0, 4, 0, 7, 6), 2, Array(6, 7)

Code chính sửa 2 dòng: (không sửa cũng được tốt, vì đã On Error Resume Next)

          For j = 1 To UBound(ArrCols)
                [COLOR=#ff0000]If ArrCols(j) > 0 Then [/COLOR]Arr(iR, j) = sArray(i, ArrCols(j))
          Next j
.......
  For h = 1 To UBound(ArrCols)
   [COLOR=#ff0000]If ArrCols(h) > 0 Then[/COLOR] Sheet2.Cells(1, h + 6) = Sheet1.Cells(1, ArrCols(h))
  Next h

 

[thanhlanh]

Đến giai đoạn này thì thấy rõ ràng việc có thêm biến HasTitle nó lợi hại thế nào...
- Nếu HasTitle = True... thích hợp khi làm việc với Range
- Nếu HasTitle = False... thích hợp khi làm việc với ComboBox, ListBox
Tức không phải lúc nào người ta cũng muốn lấy tiêu đề và ngược lại
Ngoài ra, đã xác định dữ liệu nguồn là 1 Array (sArray) thì không thể biết trước nó thuộc Base 0 hay Base 1 (dữ liệu có thể nhận từ bất cứ nguồn nào mà)
Ẹc... Ẹc... cải tiến thêm bước này phải tốn thêm chút mồ hôi nữa mới xong!

Trong code của ndu có câu:
For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
Thằng LBound(TmpArr, 1) khác kiểu với thằng này HasTitle mà sao cộng trừ được hỉ?

 

[ptm0412]

Khi cộng trừ boolean trong VBA:
True = -1
False = 0
Chắc thanhlanh muốn đổ 1 chút mồ hôi chăng?

 

[thanhlanh]

Khi cộng trừ boolean trong VBA:
True = -1
False = 0
Chắc thanhlanh muốn đổ 1 chút mồ hôi chăng?

Biết rồi, nhưng chuyển đổi trước mới cộng trừ nhân chia cho dể nhìn được không?: CDbl(HasTitle) chẳng hạn.

 

[ndu96081631]

Biết rồi, nhưng chuyển đổi trước mới cộng trừ nhân chia cho dể nhìn được không?: CDbl(HasTitle) chẳng hạn.

Nếu chuyển như vậy là quá tốt rồi, còn không cũng không có vấn đề gì
Để ý trong bảng tính, nếu A1=1, B1 =TRUE thì C1=A1+B1 vẫn = 2 như thường

 

[Hoàng Trọng Nghĩa]

Cứ cái đà này các Sư phụ sẽ thay thế thằng Pivot Table mất thôi! Để cho nó có đất sống nữa chứ!

Hôm qua em cải tiến chút xíu về việc cộng dồn có điều kiện, ví dụ nhỏ hơn 1 số nào đó, hoặc lớn hơn số nào đó, kết quả các hàng phía dưới ra như ý, nhưng hàng phía trên cùng hình như nó vẫn cộng thêm 1 giá trị đầu tiên nên bị sai. E rằng tại mình mò đại mà không đúng nên không quan tâm cũng chẳng lưu lại.

 

[ndu96081631]

Cứ cái đà này các Sư phụ sẽ thay thế thằng Pivot Table mất thôi! Để cho nó có đất sống nữa chứ!

Hôm qua em cải tiến chút xíu về việc cộng dồn có điều kiện, ví dụ nhỏ hơn 1 số nào đó, hoặc lớn hơn số nào đó, kết quả các hàng phía dưới ra như ý, nhưng hàng phía trên cùng hình như nó vẫn cộng thêm 1 giá trị đầu tiên nên bị sai. E rằng tại mình mò đại mà không đúng nên không quan tâm cũng chẳng lưu lại.

Đảm bảo với bạn rằng PivotTable là thứ mà ta không thể tranh chấp về tốc độ được
Để ý rằng chỉ khi Refresh Data thì nó mới tính toán lại, còn không thì nó vẫn hiển thị lại dữ liệu mà nó đã lưu (ở đâu đó, không biết được)
Còn hàm của ta viết, cứ chạy là phải tính toán từ đâu ---> Thua tốc độ ở chổ này là cái chắc

 

[ptm0412]

MinhThien mang sách Pivot Table về chắc không đọc kỹ rồi. Không kể đến tốc dộ tính toán, có những chức năng của Pivot Table mà không gì có thể so sánh được:

1. Pivot table có khả năng tổng hợp và phân tích đa cấp:
- Ngay trong file UniqueAndSum, Nếu kéo thêm Field04 vào Pivot table, Pivot sẽ tổng hợp chung cho từng Name, và riêng cho từng mục từ VBA001 đến VBA100.
- Nếu kéo thêm trường Maso02 vào, sẽ tổng hợp 3 cấp.
- Pivot table có thể đổi cấp tổng hợp: Chỉ cần đổi chỗ 1 field từ phải qua trái, cấp tổng hợp cho field đó sẽ đổi từ cấp thấp hơn dổi thành cấp cao hơn.

2. Sự đa dạng trong tính toán:
- Nếu sử dụng field setting ta sẽ có không chỉ Sum, Min, Max, mà còn có hàng chục cách tính toán khác nhau
- Nếu 1 field kéo thả vào Data Area nhiều lần, ta có thể vừa tính Sum, vừa tính Min, vừa tính Max, Average, ...

3. Pivot table tổng hợp và phân tích theo cả 2 chiều ngang và dọc:
- Nếu kéo thả 1 trường nào đó vào Column Area, ta sẽ có cả tổng hợp và phân tích.
- CHiều ngang cũng có thể đa cấp y như chiều dọc

4. ....

Đối với mỗi cái click chuột, mỗi cái kéo thả thêm bớt, đổi chỗ, hoán vị, ... của Pivot table, ta phải viết 1 code dài ngoằng. Thậm chí có những cái viết code không nổi, thậm chí vô phương.
Vậy:
còn khuya mới viết code thay thế được Pivot,
còn khuya mới có cái gì thay thế được cho Pivot,
và
sách lão chết tiệt vẫn còn phải đọc dài dài!

 

[Hoàng Trọng Nghĩa]

Nói vui vậy chứ làm gì mà một vài cao thủ của ta có thể làm hơn hàng vạn cái đầu lập trình của Microsoft được! Em khen ngợi các Thầy nhưng hơi cường điệu chút thôi mà! Nhưng thuận tiện thì đường thẳng ta cứ đi!

 

[Dauthivan]

Em mới biết và thực hành về Sub thôi, Funtion em chỉ mới đọc lý thuyết, em chưa hiểu lắm một số điểm về Funtion mong sư phụ chỉ cho

Function UniqueList2D(UniqueCol As Long, sArray)
  Dim ReArr
  Dim iRw, iRws, iCols, iCol, iCount
  iRws = UBound(sArray, 1)
  iCols = UBound(sArray, 2)
  ReDim ReArr(1 To iRws, 1 To iCols)
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
        For iRw = 1 To iRws
          If sArray(iRw, UniqueCol) <> "" Then
            If Not .Exists(sArray(iRw, UniqueCol)) Then
                .Add sArray(iRw, UniqueCol), ""
                iCount = iCount + 1
                For iCol = 1 To iCols
                   ReArr(iCount, iCol) = sArray(iRw, iCol)
                Next
            End If
          End If
    Next
    UniqueList2D = ReArr
  End With
End Function

Sub TEST()
  Dim Arr1, Arr2
  With Range([A3], [A65536].End(xlUp)).Resize(, 7)
    Arr1 = .Cells
    Arr2 = UniqueList2D(4, Arr1)
    [J2].Resize(UBound(Arr2, 1), 7).Value = Arr2
  End With
End Sub

Em thắc mắc sArray tại sao nó không được định nghĩa trước thì biết nó là vùng nào? Phải chăng nó chính là Arr1?

Em muốn ứng với Giá trị cột D bằng 1 (tức cột 4) em muốn lấy Ho Cam Dao dong 9 chứ không phải Ho Cam Dao dong 8 thì làm sao hả thày?
----------
Hình như em cũng hơi hơi hiểu rồi (nếu có gì không phải xin các sư phụ chỉ giúp):
- Có phải Sub chỉ chuyên môn hoá vai trò chuyền 1 số cụ thể vào cho Funtion, không tính toán gì cả (việc tính toán là dành cho Funtion)
- Funtion chỉ chuyên tính toán dựa vào trị số do Sub cung cấp? Các biến ban đầu của Funtion ban đầu chỉ chung chung để có tính tổng quát, tính toán cụ thể phải nhờ Sub

Ví dụ Sub có dòng UniqueList2D(4, Arr1), trong khi đó khai báo Funtion có đoạn Function UniqueList2D(UniqueCol As Long, sArray), từ hai ngoặc này suy ra:

UniqueCol As Long = 4
sArray = Arr1 tức là toàn bộ vùng dữ liệu đầu vào?

 

[ptm0412]

Em thắc mắc sArray tại sao nó không được định nghĩa trước thì biết nó là vùng nào? Phải chăng nó chính là Arr1?
----------
Ví dụ Sub có dòng UniqueList2D(4, Arr1), trong khi đó khai báo Funtion có đoạn Function UniqueList2D(UniqueCol As Long, sArray), từ hai ngoặc này suy ra:

UniqueCol As Long = 4
sArray = Arr1 tức là toàn bộ vùng dữ liệu đầu vào?

Cái này mới nói hiểu hiểu bên kia, qua đây lại mơ mơ màng màng. (Nhất là sau khi nghiaphuc nói về tham số hình thức và tham số thực sự)
Đúng rồi, nàng ạ.
Tuy nhiên, phát biểu này không chính xác:

- Có phải Sub chỉ chuyên môn hoá vai trò chuyền 1 số cụ thể vào cho Function, không tính toán gì cả (việc tính toán là dành cho Function)
- Function chỉ chuyên tính toán dựa vào trị số do Sub cung cấp? Các biến ban đầu của Funtion ban đầu chỉ chung chung để có tính tổng quát, tính toán cụ thể phải nhờ Sub

Function là 1 hàm tự tạo, tạo xong nó giống như hàm Sum, hàm Count của Excel. Khi cần Sum thì dùng hàm Sum, khi cần đếm thì dùng hàm Count, khi cần lọc duy nhất 1 bảng theo 1 cột nào đó làm chuẩn, thì dùng hàm tự tạo này. Nghĩa là ta có thể tạo sẵn 1 hàm để đó, khi nào cần thì lôi ra xài. Có thể xài trực tiếp tên bảng tính, có thể dùng code VBA để xài.
Dùng hàm sum thì phải cho thằng Sum cái để nó cộng, dùng hàm Count thì phải cho nó cái để nó đếm, thì dùng hàm tự tạo cũng thế thôi! Hàm tự tạo cần cái gì thì phải cho nó cái đó!

Rộng hơn nữa, ta muốn 1 sub làm những việc sau:
- từ 1 bảng nguồn, loc duy nhất theo 1 cột nào đó thành 1 mảng,
- mảng này xào nấu thêm, thành mảng thứ 3,
- mảng thứ 3 này mới gán xuống làm kết quả.

Thì bước 1 dùng hàm này, bước 2 dùng 1 công cụ khác, hoặc hàm khác.

Vậy, dùng Sub thực hiện mục đích, Function là phương tiện phụ trợ để thực hiện mục đích, chứ không phải ngược lại.

Em muốn ứng với Giá trị cột D bằng 1 (tức cột 4) em muốn lấy Ho Cam Dao dong 9 chứ không phải Ho Cam Dao dong 8 thì làm sao hả thày?

Muốn lấy dòng nào, thì phải chỉ ra tại sao lấy dòng đó, nghĩa là chỉ ra sự khác biệt của nó đối với các dòng còn lại, chứ không nói khơi khơi. Hàm này đã viết cho bài toán cụ thể của chủ topic, là lấy duy nhất, và lấy dòng đầu tiên gặp được. Lấy dòng khác, thì phải có điều kiện để lấy mới được.

 

[70211119]

Ẹc ẹc, đã làm xong. Test 50.000 dòng mất có 0,6 giây
Nói không bằng làm, làm không bằng cho xem:

Option Base 1
Sub UniqueAndSum(sArray, ArrCols, UniqueCol, ArrSumCols)
  Dim i, j, k, h As Long, iR As Long, Tmp, ReArr()
  On Error Resume Next
  ReDim Arr(1 To UBound(sArray, 1), 1 To UBound(ArrCols))
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(sArray, 1)
      If sArray(i, UniqueCol) <> "" Then
        Tmp = sArray(i, UniqueCol)
        If Not .Exists(Tmp) Then
          iR = iR + 1
          .Add Tmp, iR
          For j = 1 To UBound(ArrCols)
            Arr(iR, j) = sArray(i, ArrCols(j))
          Next j
        Else
            For j = 1 To UBound(ArrCols)
                For k = 1 To UBound(ArrSumCols)
                If ArrCols(j) = ArrSumCols(k) Then
                    Arr(.Item(Tmp), j) = Arr(.Item(Tmp), j) + sArray(i, ArrSumCols(k))
                End If
                Next k
            Next j
        End If
      End If
    Next i
  End With
  For h = 1 To UBound(ArrCols)
    Sheet2.Cells(1, h + 6) = Sheet1.Cells(1, ArrCols(h))
  Next h
  Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr
End Sub

Cho xem không bằng cho thử: Tải file đính kèm về chạy thử.
Cái này sửa 1 chút xíu là thành Function luôn

Tại dòng Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr và Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr mình thêm 1 đều kiện trong functionđể lựa chọn vị trí ghi dữ liệu được không ạ? Lúc đó hàm sẽ là UniqueAndSum Arr1, Array(2, 1, 7, 6), 2, Array(6, 7), Sheets(1).[a1]