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!

 

[ptm0412]

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]

Được. Lúc đó thủ tục (không phải hàm) là Sub UniqueAndSum Arr1, Array(2, 1, 7, 6), 2, Array(6, 7), Rng As Range)

Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr sửa thành

Rng.Resize(iR, UBound(ArrCols)).Value = Arr

Lưu ý:
Gọi thủ tục đến tham số Rng cần ghi rõ tên sheet