返回列表 上一主題 發帖

[原創] 利用字典去除重複內容

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-4-11 18:50 | 只看該作者

[原創] 利用字典去除重複內容

=IFERROR(UNIQUE($C$1:$C$10,ROW(A1)),"")



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
複製代碼
收藏 分享
ss

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
2#
發表於 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
複製代碼
ss

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
3#
發表於 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
複製代碼
ss

TOP

        靜思自在 : 世上有兩件事不能等：一、孝順 二、行善。
返回列表 上一主題