Board logo

標題: [原創] 利用字典去除重複內容 [打印本頁]
作者: sunnyso    時間: 2013-4-11 18:50     標題: 利用字典去除重複內容

=IFERROR(UNIQUE($C$1:$C$10,ROW(A1)),"")
[attach]14640[/attach]


code of UNIQUE function
  1. Function UNIQUE(source As Range, num As Integer)
  2.     Dim newArray, myArray As Variant
  3.     rows_num = source.Rows.Count
  4.     myArray = Range(source.Address).Value
  5.    
  6.     Set Dic = CreateObject("scripting.dictionary")
  7.     For i = 1 To rows_num
  8.         Dic((myArray(i, 1))) = ""
  9.     Next
  10.    
  11.     arr = Dic.Keys
  12.    
  13.     UNIQUE = arr(num - 1)
  14. End Function
複製代碼
作者: sunnyso    時間: 2013-4-11 22:16

修改Code 可以略過空白
  1. Function UNIQUE(source As Range, num As Integer)
  2.     Dim newArray, myArray As Variant
  3.     rows_num = source.Rows.Count
  4.     myArray = Range(source.Address).Value
  5.    
  6.     Set Dic = CreateObject("scripting.dictionary")
  7.     For i = 1 To rows_num
  8.         Dic(CStr(myArray(i, 1))) = ""
  9.     Next
  10.    
  11.     arr = Dic.Keys
  12.    
  13.     UNIQUE = arr(num - 1)
  14. End Function
複製代碼
作者: sunnyso    時間: 2013-4-11 22:39

回復 2# sunnyso
更新Code 略過空白
  1. Function UNIQUEp(source As Range, num As Integer)
  2.     Dim newArray, myArray As Variant
  3.     rows_num = source.Rows.Count
  4.     'myArray = Range(Cells(source.Row, source.Column), Cells(source.Row + rows_num - 1, source.Column)).Value
  5.     myArray = Range(source.Address).Value
  6.    
  7.     Set Dic = CreateObject("scripting.dictionary")
  8.     For i = 1 To rows_num
  9.     If myArray(i, 1) <> "" Then
  10.         Dic((myArray(i, 1))) = ""
  11.     End If
  12.     Next
  13.    
  14.     arr = Dic.Keys
  15.    
  16.     UNIQUEp = arr(num - 1)
  17. End Function
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)