曾经的回帖整理-字典案例部分

liulang0808

1. Public d
   
2. Public a
   
3. Public arr
   
4. Public m
   
5. Sub lqxs_zd()
   
6.     Application.ScreenUpdating = False
   
7.     ActiveSheet.UsedRange.Offset(0, 2).ClearContents
   
8.     Set d = CreateObject("scripting.dictionary")
   
9.     arr = [a1].CurrentRegion
   
10.     a = 3
    
11.     m = Application.InputBox("请输入数字：", "凑数", 10, , , , , 1)
    
12.     For j = 2 To UBound(arr)
    
13.         If arr(j, 1) < m Then
    
14.             d(j) = arr(j, 1)
    
15.             dg j
    
16.             If d.Count > 0 Then d.Remove j
    
17.         Else
    
18.             If arr(j, 1) = m Then
    
19.                 Cells(1, a) = arr(j, 1)
    
20.                 a = a + 1
    
21.             End If
    
22.         End If
    
23.         
    
24.     Next j
    
25.     Application.ScreenUpdating = True
    
26. End Sub
    
27. Sub dg(y)
    
28.     For j = y + 1 To UBound(arr)
    
29.         sm = WorksheetFunction.Sum(d.items)
    
30.         If sm + arr(j, 1) = m Then
    
31.             d(j) = arr(j, 1)
    
32.             Cells(1, a).Resize(d.Count) = WorksheetFunction.Transpose(d.items)
    
33.             a = a + 1
    
34.             d.Remove j
    
35.         Else
    
36.             If sm + arr(j, 1) < m Then
    
37.                 d(j) = arr(j, 1)
    
38.                 dg j
    
39.             End If
    
40.         End If
    
41.         If d.exists(j) Then d.Remove j
    
42.     Next j
    
43. End Sub
    

复制代码

smhf_6

版主辛苦了
字典最主要的就是一个key一个item, 还有count,exists, remove,removeall不是太多，而他的用途实在是太大了，本人在进行数据处理时，因项目过多，判断复杂，曾用到10个字典变量

liulang0808

smhf_6 发表于 2017-12-18 18:42
版主辛苦了
字典最主要的就是一个key一个item, 还有count,exists, remove,removeall不是太多，而他的用途 ...

首先是解决问题，再研究怎么优化吧
能解决问题就是好代码

law3886585

学习看，感谢版主的分享

ardu95

辛苦了，谢谢分享。学习当中。

苏阳湖wzy

非常感谢版主，辛苦了！

vfp_new

回复是为了学习，为了收藏，为了进步。

海婷

感谢版主分享！

02761752696

向版主老师学习   ，谢谢分享

liulang0808

蓝板出的题目地址链接：
[第119期]假如你是无人驾驶车上的电脑，你想好了怎么走吗？
http://club.excelhome.net/thread-1379620-1-1.html
(出处: ExcelHome技术论坛)

截止日期是12月20日，今天贴出自己的解决办法

1. Public d
   
2. Public a
   
3. Public arr
   
4. Sub lqxs_zd()
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     arr = Sheets(2).[a1].CurrentRegion
   
7.     m = WorksheetFunction.Sum(Sheets(2).Columns(3))
   
8.     d("E") = 0
   
9.     a = 6
   
10.     dg ("E")
    
11.     Set Rng = Rows(2).Find(WorksheetFunction.Min(Rows(2)), lookat:=xlWhole)
    
12.     [c2] = Rng.Value
    
13.     [d2] = Cells(1, Rng.Column)
    
14. End Sub
    
15. Sub dg(str1 As String)
    
16.     For j = 2 To UBound(arr)
    
17.         If (arr(j, 1) = "B" And arr(j, 2) = str1) Or (arr(j, 2) = "B" And arr(j, 1) = str1) Then
    
18.             d("B") = arr(j, 3)
    
19.             Cells(1, a) = Join(d.keys, "-")
    
20.             Cells(2, a) = WorksheetFunction.Sum(d.items)
    
21.             a = a + 1
    
22.             d.Remove "B"
    
23.         Else
    
24.             If arr(j, 1) = str1 And Not d.exists(arr(j, 2)) Then
    
25.                 d(arr(j, 2)) = arr(j, 3)
    
26.                 dg (arr(j, 2))
    
27.             Else
    
28.                 If arr(j, 2) = str1 And Not d.exists(arr(j, 1)) Then
    
29.                     d(arr(j, 1)) = arr(j, 3)
    
30.                     dg (arr(j, 1))
    
31.                 End If
    
32.             End If
    
33.         End If
    
34.     Next j
    
35.     d.Remove str1
    
36. End Sub
    

复制代码

使用递归+字典求最短路径