Dictinary.keys返回一维数组,因而应用比较广泛 应用实例1(顺序显示1-100): Sub usage() Dim dic As Object, i As Long Set dic = CreateObject("Scripting.Dictionary") For i = 1 To 100 dic.Add i, "" Next MsgBox Join(dic.keys, ",") Set dic=Nothing End Sub 应用实例2(显示1-100中含3的整数): Sub usage2() Dim dic As Object, i As Long Set dic = CreateObject("Scripting.Dictionary") For i = 1 To 100 dic.Add i, "" Next MsgBox Join(Filter(dic.keys, "3"), vbCrLf) Set dic=Nothing End Sub
应用实例3(WORKSHEET中A列显示1-10000): Sub usage3() Dim dic As Object, i As Long, arr Set dic = CreateObject("Scripting.Dictionary") For i = 1 To 10000 dic.Add i, "" Next arr = WorksheetFunction.Transpose(dic.keys) [a1].Resize(UBound(arr), 1) = arr Set dic = Nothing End Sub 应用实例4 (WORKSHEET中A列显示1 - 10000,B列逆序显示): Sub usage4() Dim dic As Object, i As Long, arr Set dic = CreateObject("Scripting.Dictionary") For i = 1 To 10000 dic.Add i, 10001 - i Next arr = WorksheetFunction.Transpose(dic.keys) [a1].Resize(UBound(arr), 1) = arr arr = WorksheetFunction.Transpose(dic.items) [b1].Resize(UBound(arr), 1) = arr Set dic = Nothing End Sub 应用实例5 (WORKSHEET中A列显示1 - 100000中被6除余1和5 的数字): Sub usage5() Dim dic As Object, i As Long, arr Set dic = CreateObject("Scripting.Dictionary") For i = 1 To 100000 dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "@", ""), "" Next
arr = WorksheetFunction.Transpose(Filter(dic.keys, "@")) [a1].Resize(UBound(arr), 1) = arr [a:a].Replace "@", "" Set dic = Nothing End Sub 应用实例6 (跨表不重复值提取): Sub Usage6() Application.ScreenUpdating = False Dim r As Range, arr Worksheets("All").Select With CreateObject("scripting.dictionary") For Each r In Range("D3:D" & Range("A65536").End(xlUp).Row) If Not .exists(r.Value) Then .Add r.Value, Nothing Next Worksheets("temp").Select Cells.Clear Range("a2").Resize(.Count, 1) = WorksheetFunction.Transpose(.keys) End With Application.ScreenUpdating = True End Sub 应用实例7 (COMBOBOX赋值): Private Sub UserForm_Initialize() Dim dic As Object, i As Long, arr Set dic = CreateObject("Scripting.Dictionary") For i = 1 To 1000 dic.Add i, "" Next UserForm1.ComboBox1.List = dic.keys Set dic = Nothing End Sub
|