範例一. 檢查某值是否存在於某數列（類似工作表的 COUNTIF 函數）
Sub check_Num()
Dim nums As Object
Set nums = CreateObject("Scripting.Dictionary")
For Each n In Array(123, 234, 213, 124)
nums.Add n, n
Next
If nums.Exists(222) Then MsgBox "Found!" Else MsgBox "Not Found!"
Set nums = Nothing
End Sub
也可以寫成自訂函數。
範例二. 檢查指定欄的重覆值並予以清除 (保留被清除後的空格)
Sub check_Num()
Dim nums As Object
Set nums = CreateObject("Scripting.Dictionary")
For Each c In Array("A", "C") '處理A欄及C欄
last_row = Cells(65536, c).End(xlUp).Row
For r = last_row To 1 Step -1
Set cell = Cells(r, c)
If Not nums.Exists(cell.Value) Then
nums.Add cell.Value, cell.Value
Else
cell.ClearContents
End If
Next r
nums.RemoveAll '移除Dictionary中的所有資料
Next
Set nums = Nothing
End Sub
範例三. 檢查並剔除指定欄的重覆值 (不保留空格)
Sub check_Num()
Dim nums As Object
Set nums = CreateObject("Scripting.Dictionary")
For Each c In Array("A", "C")
Set cell = Cells(1, c)
While cell <> ""
If Not nums.Exists(cell.Value) Then
nums.Add cell.Value, cell.Value
End If
Set cell = cell.Offset(1, 0)
Wend
Columns(c).ClearContents
r = 1 '從第1列開始再寫回儲存格
For Each num In nums
Cells(r, c) = num
r = r + 1
Next
nums.RemoveAll
Next
Set nums = Nothing
End Sub
也可以放入 Range
Sub Ex()
Dim D As Object, K
Set D = CreateObject("Scripting.Dictionary")
D.Add Cells(1, 1), ""
D.Add Cells(2, 1), ""
For Each K In D.KEYS
MsgBox K.Address
Next
End Sub作者: chin15 時間: 2011-3-29 21:30
