数据字典多个实例

113 阅读 0 评论 75 点赞

我是靠谱客的博主甜美秋天，最近开发中收集的这篇文章主要介绍数据字典多个实例，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

http://club.excelhome.net/dispbbs.asp?BoardID=2&ID=211734&replyID=&skin=0

by northwolves

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

'应用实例8 (字符频率统计):

'本例统计圆周率前500位中各数字出现的频率并显示在WORKSHEET的前两行
Sub Usage8()
Const pi As String = "3.14159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651328230664709384460955058223172535940812848111745028410270193852110555964462294895493038196442881097566593344612847564823378678316527120190914564856692346034861045432664821339360726024914127372458700660631558817488152092096282925409171536436789259036001133053054882046652138414695194151160943305727036575959195309218611738193261179310511854807446237996274956735188575272489122793818301194912"
Dim i As Long, temp As String, dic As Object
Set dic = CreateObject("scripting.dictionary")
For i = 3 To Len(pi)
temp = Mid(pi, i, 1)
If Not dic.exists(temp) Then
dic.Add temp, 1
Else
dic(temp) = dic(temp) + 1
End If
Next
[a1:a2] = WorksheetFunction.Transpose(Array("Number", "出现次数"))
[b1].Resize(1, dic.Count) = dic.keys
[b2].Resize(1, dic.Count) = dic.items
Set dic = Nothing
End Sub

'本例统计某字符串中各字符出现的频率并显示在WORKSHEET的前两行

Sub Usage8_2()
Const s As String = "在VBA中有一个数据字典即dictionary功能很好，运行速度比较快，掌握以后可以替代一些其他查找功能，现向老师请教数据字典即dictionary的基本原理是怎样的，它适合于哪些情况之下可以运用，在运用过程中应当注意哪些问题。"
Dim i As Long, temp As String, dic As Object
Set dic = CreateObject("scripting.dictionary")
For i = 1 To Len(s)
temp = Mid(s, i, 1)
If Not dic.exists(temp) Then
dic.Add temp, 1
Else
dic(temp) = dic(temp) + 1
End If
Next
[a1:a2] = WorksheetFunction.Transpose(Array("字符", "出现次数"))
[b1].Resize(1, dic.Count) = dic.keys
[b2].Resize(1, dic.Count) = dic.items
Set dic = Nothing
End Sub