Hàm tự tạo để tạo danh sách duy nhất không có lỗi và những số 0

[ManhDuc1382]

Chào các bạn. Mình có một code hàm lọc ra danh sách duy nhất Unique như ở trong file đính kèm. Hàm này có thể lọc ra danh sách duy nhất trong trường hợp có nhiều điều kiện, tuy nhiên kết quả trả về của hàm bị thừa số 0 và xuất hiện nhiều ô lỗi, vậy mình muốn nhờ các bạn sửa lại code hàm này giúp mình để tạo ra danh sách duy nhất không có lỗi và loại bỏ những số 0 không cần thiết (nếu danh sách ban đầu có số 0 mà dòng đó thỏa mãn thì tất nhiên nó sẽ nằm trong kết quả, chỉ loại bỏ nếu thực sự không có số 0 nào trong danh sách ban đầu). Mình cảm ơn

 

[ndu96081631]

Chào các bạn. Mình có một code hàm lọc ra danh sách duy nhất Unique như ở trong file đính kèm. Hàm này có thể lọc ra danh sách duy nhất trong trường hợp có nhiều điều kiện, tuy nhiên kết quả trả về của hàm bị thừa số 0 và xuất hiện nhiều ô lỗi, vậy mình muốn nhờ các bạn sửa lại code hàm này giúp mình để tạo ra danh sách duy nhất không có lỗi và loại bỏ những số 0 không cần thiết (nếu danh sách ban đầu có số 0 mà dòng đó thỏa mãn thì tất nhiên nó sẽ nằm trong kết quả, chỉ loại bỏ nếu thực sự không có số 0 nào trong danh sách ban đầu). Mình cảm ơn

Trước tôi có viết hàm Unique thế này:

Function UniqueList(ParamArray Arrays())
  Dim key, aTmp, aSub
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each aSub In Arrays
      aTmp = aSub
      If Not IsArray(aTmp) Then aTmp = Array(aTmp)
      For Each key In aTmp
        If TypeName(key) <> "Error" Then
          If Len(key) Then
            If Not .Exists(key) Then .Add key, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End

Áp dụng vào sheet

=TRANSPOSE(UniqueList(IF(F4:F14="x",E4:E14,1/0)))

và:

=COUNTA(UniqueList(IF(F4:F14="x",E4:E14,1/0)))

 

[ManhDuc1382]

Trước tôi có viết hàm Unique thế này:

Function UniqueList(ParamArray Arrays())
  Dim key, aTmp, aSub
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each aSub In Arrays
      aTmp = aSub
      If Not IsArray(aTmp) Then aTmp = Array(aTmp)
      For Each key In aTmp
        If TypeName(key) <> "Error" Then
          If Len(key) Then
            If Not .Exists(key) Then .Add key, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End

Áp dụng vào sheet

=TRANSPOSE(UniqueList(IF(F4:F14="x",E4:E14,1/0)))

và:

=COUNTA(UniqueList(IF(F4:F14="x",E4:E14,1/0)))

vâng anh, vậy hàm này mình xử lý những lỗi N/A thế nào anh nhỉ

 

[ndu96081631]

vâng anh, vậy hàm này mình xử lý những lỗi N/A thế nào anh nhỉ

Muốn bỏ N/A thì nên dùng INDEX tại cell H4 như sau:

=IFERROR(INDEX(UniqueList(IF($E$4:$E$11="x",$D$4:$D$11,1/0)),ROW($A1)),"")

Kéo fill xuống

 

[ManhDuc1382]

Muốn bỏ N/A thì nên dùng INDEX tại cell H4 như sau:

=IFERROR(INDEX(UniqueList(IF($E$4:$E$11="x",$D$4:$D$11,1/0)),ROW($A1)),"")

Kéo fill xuống

vâng ok anh ạ

 

[ManhDuc1382]

Trước tôi có viết hàm Unique thế này:

Function UniqueList(ParamArray Arrays())
  Dim key, aTmp, aSub
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each aSub In Arrays
      aTmp = aSub
      If Not IsArray(aTmp) Then aTmp = Array(aTmp)
      For Each key In aTmp
        If TypeName(key) <> "Error" Then
          If Len(key) Then
            If Not .Exists(key) Then .Add key, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End

Áp dụng vào sheet

=TRANSPOSE(UniqueList(IF(F4:F14="x",E4:E14,1/0)))

và:

=COUNTA(UniqueList(IF(F4:F14="x",E4:E14,1/0)))

Anh ơi em có tìm hiểu về hàm UniqueList của anh thì thấy còn một mã như sau, vậy cho em hỏi mã mà anh vừa viết ở trên là mã đã được cập nhật gần đây nhất ạ

Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        If TypeName(Item) <> "Error" Then
          tmp = CStr(Item)
          If Len(tmp) Then
            If Not .Exists(tmp) Then .Add tmp, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function

 

[ndu96081631]

Anh ơi em có tìm hiểu về hàm UniqueList của anh thì thấy còn một mã như sau, vậy cho em hỏi mã mà anh vừa viết ở trên là mã đã được cập nhật gần đây nhất ạ

Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        If TypeName(Item) <> "Error" Then
          tmp = CStr(Item)
          If Len(tmp) Then
            If Not .Exists(tmp) Then .Add tmp, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function

2 cái gần như nhau về mặt thuật toán.
Kiểu như lâu lâu mở ra xem lại thấy ngứa mắt nên gọt gọt giũa giũa cho nó đẹp đẹp chút thôi mà

 

[ManhDuc1382]

2 cái gần như nhau về mặt thuật toán.
Kiểu như lâu lâu mở ra xem lại thấy ngứa mắt nên gọt gọt giũa giũa cho nó đẹp đẹp chút thôi mà

vâng ạ, em sẽ lưu cả 2 hàm này về để lần sau dùng