常见字典用法集锦及代码详解

fhb197999

蓝版的东东，一句话，“没得说的”，先拜读再说

志哥

蓝桥玄霜 发表于 2010-10-18 12:50
实例3  A列中显示1 ~ 1000中被6除余1和余5 的数字
一、问题的提出：
有1、2、3…1000一千个数字，要求编写 ...

首先感谢LZ的帖子教我学会了很多知识。下面根据示例代码简化，抛砖引玉。

示例3 代码简化，根据狼版 的代码改编

1. Sub 余1余5()  
   
2. Dim dic As Object, i As Long, arr
   
3. Set dic = CreateObject("Scripting.Dictionary")
   
4. For i = 1 To 1000
   
5. If Abs(i Mod 6 - 3) = 2 Then dic.Add i, ""
   
6. Next
   
7. arr = WorksheetFunction.Transpose(dic.keys)
   
8. Cells(1, 2).Resize(UBound(arr), 1) = arr
   
9. Set dic = Nothing
   
10. End Sub
    

复制代码

示例6代码简化

1. Sub shili6()
   
2. Dim d As Object, a, b, i&
   
3. Dim ss$, n!
   
4. 'Me.UsedRange.Offset(3, 0) = ""
   
5. Cells(3, 2).Resize(1, 8) = Split("位置,大系统编号,小系统编号,项目名称,比例相同,楼层数,长度明细,数量", ",")
   
6. Range(Cells(4, 2), Cells(Rows.Count, 9)).ClearContents
   
7. a = Sheet1.Range(Sheet1.[a4], Sheet1.[i65536].End(xlUp))
   
8. Set d = CreateObject("scripting.dictionary")
   
9. ReDim b(1 To UBound(a), 1 To 8)
   
10. 
    
11. For i = 1 To UBound(a)
    
12. ss = a(i, 1) & a(i, 2) & a(i, 4) & a(i, 5) & a(i, 6) & a(i, 8)
    
13. If Not d.Exists(ss) Then
    
14. n = n + 1
    
15. d.Add ss, n
    
16. b(n, 1) = a(i, 2): b(n, 2) = a(i, 5): b(n, 3) = a(i, 6): b(n, 4) = a(i, 4)
    
17. b(n, 5) = a(i, 1): b(n, 6) = a(i, 8): b(n, 7) = a(i, 9)
    
18. b(d(ss), 8) = b(d(ss), 7)
    
19. Else
    
20. b(d(ss), 7) = b(d(ss), 7) & "+" & a(i, 9)
    
21. b(d(ss), 8) = (b(d(ss), 8) + a(i, 9))
    
22. End If
    
23. Next
    
24. 
    
25. For i = 1 To d.Count
    
26. b(i, 8) = b(i, 5) * b(i, 6) * b(i, 8) / 100
    
27. Next
    
28. 
    
29. [b4].Resize(n, 8) = b
    
30. End Sub

复制代码

示例10代码简化，少了几个循环，速度更快。

1. Sub 示例10()
   
2. Dim i&, Myr&, Arr
   
3. Dim d, x, rng
   
4. 
   
5. Application.ScreenUpdating = False
   
6. Set d = CreateObject("Scripting.Dictionary")
   
7. Sheet1.Activate
   
8. Myr = [a65536].End(xlUp).Row
   
9. Range("A1:C" & Myr).Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range( _
   
10.         "A2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlDescending, _
    
11.         Header:=xlYes 'AC列升序，B列降序
    
12. Arr = Range("a2:c" & Myr)
    
13. 
    
14. [e:g].ClearContents
    
15. j = 2
    
16. For i = 1 To UBound(Arr)
    
17.     x = Arr(i, 1) & "|" & Arr(i, 3)
    
18. If Not d.exists(x) Then
    
19. Cells(j, 5).Resize(1, 3) = WorksheetFunction.Index(Arr, i, 0)
    
20. j = j + 1
    
21. End If
    
22. d(x) = ""
    
23. Next
    
24. 
    
25. Set d = Nothing
    
26. Application.ScreenUpdating = True
    
27. End Sub

复制代码

zhangxu168168

占位学习，请勿怪。

szf_790403

谢谢蓝桥版主，有空了慢慢学习、

staer001

强！蜚常不错的贴子。收藏了。{:soso_e100:}

yuk_yu

继续学习！！

ｗǒ㊣ご看海

收藏学习{:soso_e129:}

Excel2119

总会有经典出现，好喜欢！感谢楼主！

zjyxp

谢谢版主分享，学习字典

yclotus

这个资料很有用。。。。{:soso_e179:}