字典用法的补充.doc

字典用法的补充index函数很多前辈都谈过字典的用法，而我这里要说的是关于在字典中取key和item的值的方法。这个是我在回答/viewth . &extra=page%3D1这个帖子时想到的。 引用:12345123取上面数据其中出现只有一次的数据放到sheet2中。我首先想到的就是用字典，于是就有了下面的部分代码： 代码:Sub cc() Dim i&, arr, d As Object arr = Range(a1, a65536.End(3) Set d = CreateObject(Scripting.Dictionary) For i = 1 To UBound(arr) d(arr(i, 1) = d(arr(i, 1) + 1 Next至此，字典完成，在keys中，分别是1、2、3、4、5，在items中分别是2、2、2、1、1。现在要把item为1的key提取出来，以往我的想法是： 代码: s = d.keys ss = d.items For i = 0 To UBound(ss) If ss(i) = 1 Then brr(j) = s(i) End If Next即：分别把keys和items赋给s和ss，然后对比，将item中等于1的key传递到另一个数组中。这时，我突然记起，取数组arr的第n行赋值到某行区域的代码：a6:c6=Application.Index(arr,n)于是想到，用index函数可以取字典中的值吗？接着，我开始修改代码，便有了下面： 代码:For i = 1 To d.CountIf Application.WorksheetFunction.Index(d.items, i) 1 Thend.Remove Application.WorksheetFunction.Index(d.keys, i)End IfNext我用Sheet2.a1.Resize(d.Count) = WorksheetFunction.Transpose(d.keys)一试，结果却多了一个2，成了2、4、5。此时才醒悟，在删除时，一般都是逆向的，以免下面的数据取代了已删除数据的位置，于是就有了最终的代码。 代码:Sub cc() Dim i&, arr, s, d As Object On Error Resume Next arr = Range(a1, a65536.End(3) Set d = CreateObject(Scripting.Dictionary) For i = 1 To UBound(arr) d(arr(i, 1) = d(arr(i, 1) + 1 Next For i = d.Count To 1 Step -1 If Application.WorksheetFunction.Index(d.items, i) 1 Then d.Remove Application.WorksheetFunction.Index(d.keys, i) End If Next Sheet2.a1.Resize(d.Count) = WorksheetFunction.Transpose(d.keys)End Sub这样，省去了很多代码，少走了弯路，也提高了速度。总结：Application.WorksheetFunction.Index(d.items, i)这个方法有很多的应用之处，以前很少看到别人用，现在发现了它的好处，便拿来与大家分享。以上个人见解，有不当之处，请各位达人指教。ivan9025 于 2010-1-2 02:11如果单考虑执行效率，用不着套用函数index呀(楼主是不是走远了.)，例如：Sub cc() Dim i&, arr, s, d As Object On Error Resume Next arr = Range(a1, a65536.End(3) Set d = CreateObject(Scripting.Dictionary) For i = 1 To UBound(arr) d(arr(i, 1) = d(arr(i, 1) + 1 Next For i = d.Count To 1 Step -1 If d(d.keys(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) Next Sheet2.a1.Resize(d.Count) =application.Transpose(d.keys)End Subd可以看成一个二维数组，d.keys和d.items分别是存在对应关系的一维数组.换而言之：既有d.count的属性，就会有d.keys(i)和d.Items(i)的方法，提供序号就可访问他们原始数据字典加工后12345123字典序号01234Keys1 d.Keys(0)2 d.Keys(1)3 d.Keys(2)4 d.Keys(3)5 d.Keys(4)Items2 d.Items(0) 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.Items(4) d(d.keys(4)Transpose后:原始数据字典加工后字典序号KeysItems重复1次及以上重复0次101 d.Keys(0)2 d.Items(0) d(d.keys(0)14212 d.Keys(1)2 d.Items(1) d(d.keys(1)25323 d.Keys(2)2 d.Items(2) d(d.keys(2)3434 d.Keys(3)1 d.Items(3) d(d.keys(3)545 d.Keys(4)1 d.Items(4) d(d.keys(4)123我相信ivan9025一定没有测试你的代码。像你这样的写法，我以前都曾经试过的，这样是通不过的。你的确可以把它看成一个数组，毕竟它的一些特点和数组很类似，但是却不可以用诸如d.keys(i)、d.items(i)的方法取得字典中的数据，否则之前我也不会用s=d.keys这样的办法。Lipdon：新年快乐字典可以按位置取值的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 - 1 Debug.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 Step -1 If d.Items(i) = b1 Then d.Remove d.Keys(i) End If Next iEnd Subccwan ：lipdon老师的帖子让我受益匪浅。多谢指教。也祝您新年快乐我想请教，就以1楼的例子，代码应该怎样写呢？下面的代码通不过。Sub cc() Dim i&, arr, s, d As Object On Error Resume Next arr = Range(a1, a65536.End(3) Set d = CreateObject(Scripting.Dictionary) For i = 1 To UBound(arr) d(arr(i, 1) = d(arr(i, 1) + 1 Next Stop For i = d.Count - 1 To 0 Step -1 If d.Items(i) 1 Then d.Remove d.Keys(i) End If Next Sheet2.a1.Resize(d.Count) = WorksheetFunction.Transpose(d.Keys)End SubLipdon：请测试，引用字典后可以用，原因不明，请各位老师出手指点迷津Sub cc() Dim i&, arr, s Dim d As New Dictionary On Error Resume Next arr = Sheet1.Range(a1, a65536.End(3) For i = 1 To UBound(arr) d(arr(i, 1) = d(arr(i, 1) + 1 Next Stop For i = d.Count - 1 To 0 Step -1 If d.Items(i) 1 Then d.Remove d.Keys(i) End If Next Sheet2.a1.Resize(d.Count) = WorksheetFunction.Transpose(d.Keys)End SubSub bbb() Dim dic1 As New Dictionary For i = 1 To 10 dic1(i) = 11 - i Next MsgBox dic1.Keys(0) & vbCrLf & dic1.Items(0) & _ vbCrLf & dic1.Item(1)End Sub贴出我测试的代码,以示歉意(为了代码的书写方便,更为了提高执行效率,本人很少用后期绑定,以致忽略了后期绑定的错误提示).但就字典本身而言,它的确是数组,否则不会有d.count的属性ivan9025：Sub test() Dim dic As New Dictionary Dim LastRow%, i%, k% With Sheet2 LastRow = .Range(a65536).End(xlUp).Row For i = 2 To LastRow dic(.Cells(i, 1) & ) = dic(.Cells(i, 1) & ) + 1 Next For i = 0 To dic.Count - 1 If dic(dic.Keys(i) 1 Then .Cells(i + 2, 2) = dic.Keys(i) Else .Cells(k + 2, 3) = dic.Keys(i) k = k + 1 End If Next .Range(c2).Resize(dic.Count) = Application.Transpose(dic.Keys) End WithEnd SubCcwan：多谢ivan9025兄让我开了眼界，以前真是不知这样的用法。不过ivan9025兄，如果不是在工作表循环，而是使用数组，速度会快10倍以上哦。多谢ivan9025老师指教。如我在22楼所说，应该是定义Dictionary和Object的区别。Option ExplicitSub cc() Dim i%, aa As Double, arr, dic As New Dictionary aa = Timer arr = Sheet1.Range(Sheet1.a3, Sheet1.d65536.End(3) For i = 1 To UBound(arr) Set dic(arr(i, 2) = arr(i, 3) & # & arr(i, 4) Next With Sheet4 Application.ScreenUpdating = False .b3:d1000.ClearContents .b3.Resize(dic.Count) = WorksheetFunction.Transpose(dic.Keys) .c3.Resize(dic.Count, 2) = WorksheetFunction.Transpose(dic.Items) .c:c.Replace #*, : .d:d.Replace *#, End With MsgBox Timer - aa Application.ScreenUpdating = TrueEnd Sub回复 29楼 ccwan 的帖子呵呵,不知楼主十倍的效率从何说起?是否认真测试过两段代码?不可妄而言之.如果你细细比较哈.,因为你的填充没有带格式,这是你觉得数组效率高的原因,麻烦你带下格式填充(框线)再论效率.数组和字典都是基本原理,效率得看需要的效果./viewth . p;extra=&page=1你先看看这贴,一目了然Sub cc() Dim i As Long Dim D As Object Dim s, arr ar