字典用法的补充

1、字典用法的补充 一index函数很多前辈都谈过字典的用法，而我这里要说的是关于在字典中取key和item的值的方法。这个是我在回答 http:/club.excelhome. net/viewth . &extra=page%3D1 这个帖子时想到的。 引用：12345123取上面数据其中出现只有一次的数据放到sheet2中。我首先想到的就是用字典，于是就有了下面的部分代码：代码：Sub cc()Dim i&, arr, d As Objectarr = Ra nge(a1, a65536.E nd( 3)Set d = CreateObject(Scriptin g.Dictio nary)

2、For i = 1 To UBou nd(arr)d(arr(i, 1) = d(arr(i, 1) + 1Next至此，字典完成，在 keys中，分别是1、2、3、4、5，在items中分别是2、2、2、1、1。现在要把item为1的key提取出来，以往我的想法是：代码：s = d.keysss = d.itemsFor i = 0 To UBou nd(ss)If ss(i) = 1 The nbrr(j) = s(i)End IfNext即：分别把keys和items赋给s和ss,然后对比，将item中等于1的key传递到另一个数 组中。这时，我突然记起，取数组arr的第n行赋值到某行区

3、域的代码：a6:c6=Application.lndex(arr,n)于是想到，用index函数可以取字典中的值吗？接着，我开始修改代码，便有了下面：代码：For i = 1 To d.Cou ntIf Applicati on. WorksheetF unction.ln dex(d.items, i) 1 Thend.Remove Applicati on. WorksheetF unction.ln dex(d.keys, i)End IfNext我用 Sheet2.a1.Resize(d.Count) = WorksheetFunction.Transpose(d.keys) 试，结果

4、却多了一个 2，成了 2、 4、 5。此时才醒悟，在删除时，一般都是逆向的，以免下面的数据取代了已删 除数据的位置，于是就有了最终的代码。代码:Sub cc()Dim i&, arr, s, d As ObjectOn Error Resume Nextarr = Range(a1, a65536.End(3)Set d = CreateObject(Scripting.Dictionary)For i = 1 To UBound(arr)d(arr(i, 1) = d(arr(i, 1) + 1NextFor i = d.Count To 1 Step -1If Application.Wo

5、rksheetFunction.Index(d.items, i) 1 Thend.Remove Application.WorksheetFunction.Index(d.keys, i)End IfNextSheet2.a1.Resize(d.Count) = WorksheetFunction.Transpose(d.keys)End Sub这样，省去了很多代码，少走了弯路，也提高了速度。总结： Application.WorksheetFunction.Index(d.items, i) 这个方法有很多的应用之处，以前很少 看到别人用，现在发现了它的好处，便拿来与大家分享。以上个人见解

6、，有不当之处，请各位达人指教。ivan9025 于 2010-1-2 02:11 如果单考虑执行效率，用不着套用函数index 呀 (楼主是不是走远了 )，例如：Sub cc()Dim i&, arr, s, d As ObjectOn Error Resume Nextarr = Range(a1, a65536.End(3)Set d = CreateObject(Scripting.Dictionary)For i = 1 To UBound(arr)d(arr(i, 1) = d(arr(i, 1) + 1NextFor i = d.Count To 1 Step -1If d(d.k

7、eys(i) 1 Then d.Remove d.keys(i)按你的愿意(这样，省去了很多代码，少走了弯路，也提高了速度。 ) ,甚至可以是 If d.Items(i) 1 Then d.Remove d.keys(i) ，因为 d(d.keys(i)d.Items(i)NextSheet2.a1.Resize(d.Count) =application.Transpose(d.keys)End Subd 可以看成一个二维数组， d.keys 和 d.items 分别是存在对应关系的一维数组 换而言之：既有 d.count 的属性，就会有 d.keys(i) 和 d.Items(i) 的方法

8、，提供序号就可访问他 们原始数据字典 序号01234Keys1 d.Keys(O)2 d.Keys(1)3d.Keys(2)4d.Keys(3)5d.Keys(4)Items2 d.ltems(O) d(d.keys(0)2 d.Items(1) d(d.keys(1)2 d.Items(2) d(d.keys(2)1 d.Items(3) d(d.keys(3)1 d.I tems(4) d(d.keys(4)Transpose后:原始数据字典 序号KeysItems重复1次及以上重复0次101 d.Keys(0)2 d.Items(0) d(d.keys(0)142字典加12 d.Keys

9、(1)2 d.I tems(1) d(d.keys(1)25323d.Keys(2)2 d.Items(2) d(d.keys(2)34工后34d.Keys(3)1 d.I tems(3) d(d.keys(3)545d.Keys(4)1 d.I tems(4) d(d.keys(4)123我相信 ivan9025 一定没有测试你的代码。像你这样的写法，我以前都曾经试过的，这样是 通不过的。你的确可以把它看成一个数组，毕竟它的一些特点和数组很类似，但是却不可以用诸如d.keys(i) 、 d.items(i) 的方法取得字典中的数据，否则之前我也不会用s=d.keys 这样的办法。Lipdon

10、 ：新年快乐字典可以按位置取值的Sub test()Dim d As New DictionaryDim i As Integerd.Add a, a1d.Add b, b1d.Add c, c1 按位置循环取值For i = 0 To d.Count - 1Debug.Print d.Keys(i)Debug.Print d.Items(i)Next iEnd SubSub test1()Dim d As New DictionaryDim i As Integerd.Add a, a1d.Add b, b1d.Add c, c1 按位置移除值For i = d.Count - 1 To 0

11、 Step -1If d.Items(i) = b1 Thend.Remove d.Keys(i)End IfNext iEnd Subccwan ： lipdon 老师的帖子让我受益匪浅。多谢指教。也祝您新年快乐 我想请教，就以 1 楼的例子，代码应该怎样写呢？ 下面的代码通不过。Sub cc()Dim i&, arr, s, d As ObjectOn Error Resume Nextarr = Range(a1, a65536.End(3)Set d = CreateObject(Scripting.Dictionary)For i = 1 To UBound(arr)d(arr(i,

12、 1) = d(arr(i, 1) + 1NextStopFor i = d.Count - 1 To 0 Step -1If d.Items(i) 1 Then d.Remove d.Keys(i) End IfNextSheet2.a1.Resize(d.Count) WorksheetFunction.Transpose(d.Keys)End SubLipdon ：请测试，引用字典后可以用，原因不明，请各位老师出手指点迷津 Sub cc()Dim i&, arr, sDim d As New DictionaryOn Error Resume Nextarr = Sheet1.Range

13、(a1, a65536.End(3)For i = 1 To UBound(arr)d(arr(i, 1) = d(arr(i, 1) + 1NextStopFor i = d.Count - 1 To 0 Step -1If d.Items(i) 1 Thend.Remove d.Keys(i)End IfNextSheet2.a1.Resize(d.Count) = WorksheetFunction.Transpose(d.Keys) End SubSub bbb()Dim dic1 As New DictionaryFor i = 1 To 10dic1(i) = 11 - iNext

14、MsgBox dic1.Keys(0) & vbCrLf & dic1.Items(0) & _ vbCrLf & dic1.Item(1)End Sub,本人很少用后期绑贴出我测试的代码 ,以示歉意 (为了代码的书写方便 ,更为了提高执行效率 定,以致忽略了后期绑定的错误提示 )但就字典本身而言 ,它的确是数组 ,否则不会有 d.count 的属性ivan9025 ：Sub test()Dim dic As New DictionaryDim LastRow%, i%, k%With Sheet2LastRow = .Range(a65536).End(xlUp).RowFor i = 2

15、To LastRowdic(.Cells(i, 1) & ) = dic(.Cells(i, 1) & ) + 1NextFor i = 0 To dic.Count - 1If dic(dic.Keys(i) 1 Then.Cells(i + 2, 2) = dic.Keys(i)Else.Cells(k + 2, 3) = dic.Keys(i)k = k + 1End IfNext.Range(c2).Resize(dic.Count) = Application.Transpose(dic.Keys)End WithEnd SubCcwan：多谢ivan9025兄让我开了眼界，以前真是

16、不知这样的用法。不过 ivan9025 兄，如果不是在工作表循环，而是使用数组，速度会快 多谢 ivan9025 老师指教。如我在 22 楼所说，应该是定义 Dictionary 和 Object 的区别。Option ExplicitSub cc()Dim i%, aa As Double, arr, dic As New Dictionaryaa = Timerarr = Sheet1.Range(Sheet1.a3, Sheet1.d65536.End(3)For i = 1 To UBound(arr)Set dic(arr(i, 2) = arr(i, 3) & # & arr(i,

17、 4)NextWith Sheet4Application.ScreenUpdating = False.b3:d1000.ClearContents.b3.Resize(dic.Count)WorksheetFunction.Transpose(dic.Keys).c3.Resize(dic.Count,WorksheetFunction.Transpose(dic.Items).c:c.Replace #*, : .d:d.Replace *#, End WithMsgBox Timer - aaApplication.ScreenUpdating = TrueEnd Sub10 倍以上哦。2)回复 29 楼 ccwan 的帖子，麻烦你带下如果你细细比较哈 ，因为你的填充没有带格式，这是你觉得数组效率高的原因 格式填充(框线)再论效率数组和字典都是基本原理，效率得看需要的效果 http:/club.excelhome .n et/viewth . p;extra=&page=1你先看看这贴，一目了然Sub cc()Dim i As LongDim D As ObjectDim s, arrarr =