一个熟悉字典的学习建议及一个实例的字典学习

e表格学习

山菊花老师的《正松舒，慢匀稳——太极字典少年班》深入浅出、生动幽默，对于字典学习大有裨益，不知道的E友可点击：“知识树”--编程开发参考--VBA语言基础--数组集合和字典--本帖。
最后部分的“感动中国人物评选”不便于初学者用F8按钮在“本地窗口”中逐步查看，再山菊花老师的指导下，本人悉心整理了一个便于逐步观察程序运行、适合初学者学习的“评选表”，当然，实质上与原表是一样的，只是暂时将“事件程序”取消了，并增加了一些注释。 人物评选表.zip (488.99 KB, 下载次数: 125)

2015-7-8 14:56 上传

点击文件名下载附件
真的耗费脑细胞

1. '原工作表感动中国人物评选“事件”程序不便于按F8按钮在本地窗口中逐步查看
   
2. '以下程序将“事件”去掉，并增加了观察用语句，就便于按F8按钮在本地窗口中逐步查看了
   
3. '置于最高处的变量申明有二个作用
   
4. '1.作用于每一个过程
   
5. '2.过程结束后，变量保持最终状态不变（除非进行“开始化”，否则此处字典d、数组Arr、条目s、下标上界k总保持最终状态不变）
   
6. '注：如将置顶申明变量语句注释掉，则“开始化”时会报错。这也说明了申明变量的必要性
   
7. '注：数组多设置的最后一个空列（9=8+1）是“删除姓名”过程的技术需要
   
8. Dim d As Object, Arr(1 To 2, 1 To 9), s%, k%      '数组变量是变体变量，变体变量无需申明变量类型。
   
9. Sub 二零二零年感动中国人物评选()
   
10.     Set d = CreateObject("Scripting.Dictionary")    '后期绑定字典
    
11.     Call 开始化     '调用位于最下面的“开始化”过程
    
12. End Sub
    
13. 
    
14. Sub 投票()
    
15.     Dim s1%, i, j, m    'i, j, m都是变体变量
    
16.     If [h26] = "" Then Exit Sub     '如果h26为空，则退出Sub代码块，否则…
    
17.     s1 = d([h26].Value)     '查字典：调出字典中此关键字（姓名）的条目；如字典中无此关键字，则字典会首先自动添加此关键字（其条目为空值或0）
    
18.                                        '夸张点说：d("关键字")=x或x=d("关键字")是字典学习中的全部内容！前者叫"挥之即去"(入典)、后者叫"召之即来"(显示)
    
19.     i = d.Keys      '第一次观察字典；关键字（姓名）集合
    
20.     j = d.Items     '第一次观察字典；条目集合
    
21.     k = UBound(Arr, 2)      '空白计票列的列数(k=9)。UBound表示数组上标；2表示“第二维”（即1 To 9列）
    
22.     If s1 = 0 Then      '如果是首次出现的候选人姓名，则…
    
23.         If s < k - 1 Then       '如果“姓名票数”表中已有的候选人姓名所占的列数没有超过7，则…
    
24.             s = s + 1       '在原有列数的基础上加一列(注：初始列数为0)
    
25.             d([h26].Value) = s      '修改字典：将字典中关键字[h26].Value的条目由0改为s
    
26.                                               '关键字的条目亦即“姓名票数”表中候选人姓名所在的列数
    
27.             s1 = s      '将s值赋给s1
    
28.                             '注意：本句为下面Arr(2, s1) = Arr(2, s1) + 1所用
    
29.                             '注意：s1绝不会通过s1 = d([h26].Value)反向(自左至右)给关键字修改条目
    
30.                             '也就是说，字典不会容忍类似5=d("关键字")这样的"语句"存在
    
31.             i = d.Keys      '更改条目后观察字典；关键字（候选人姓名）集合
    
32.             j = d.Items     '更改条目后观察字典；条目（候选人姓名所在列数）集合
    
33.             Arr(1, s) = [h26].Value     '将首次出现的候选人姓名写入数组1行s列
    
34.         End If
    
35.     End If
    
36.     If s1 Then Arr(2, s1) = Arr(2, s1) + 1      '字典中存在其数组列数(条目，且不为0)的同一姓名的票数累加
    
37.     m = Arr     '观察用；数组状态（此数组将写入投票区域h28:o29）
    
38.         If d([h26].Value) = 0 Then
    
39.         MsgBox "候选人数不能超过" & k - 1 & "位！", 48, "提示"       '此句中=0更换为=""亦可
    
40.         d.Remove ([h26].Value)      '从字典中同时清除多余的姓名和这个姓名的条目
    
41.         End If
    
42.     Range("k26").Value = "刚才录入的是：" & [h26].Value     '备忘录语句
    
43.     i = d.Keys      '“投票“之前再观察一次字典；关键字（候选人姓名）集合
    
44.     j = d.Items     '“投票“之前再观察一次字典；条目（候选人姓名所在列数）集合
    
45.     Range("h26:i26").ClearContents      '清除区域中的内容
    
46.     Range("h28:o29").Value = Arr        '投票，即将数组内的值赋给单元格区域
    
47.     [h26].Activate      '激活“姓名”输入单元格
    
48. End Sub
    
49. 
    
50. Sub 更改姓名()
    
51.     If Range("i31").Value = "" Or Range("i32").Value = "" Then Exit Sub
    
52.     If d.Exists(Range("i32").Value) Then    '如果关键字存在，则…
    
53.         MsgBox "已经存在姓名" & Range("i32").Value & "，不能改名！", 48, "改名"
    
54.     Else    '否则…
    
55.         s1 = d(Range("i31").Value)      '查字典
    
56.         i = d.Keys      '观察用；关键字（候选人姓名）集合
    
57.         j = d.Items     '观察用；条目（候选人姓名所在列数）集合
    
58.         d.Key(Range("i31").Value) = Range("i32").Value  '更改字典中的关键字（候选人姓名）
    
59.         i = d.Keys      '观察用；关键字（候选人姓名）集合
    
60.         j = d.Items     '观察用；条目（候选人姓名所在列数）集合
    
61.         m = Arr     '观察用；改名之前数组的状态
    
62.         Arr(1, s1) = Range("i32").Value     '更改数组中的候选人姓名
    
63.         m = Arr     '观察用；改名之后数组的状态
    
64.         Range("i31:j32").ClearContents      '清除区域中的内容
    
65.         Range("h28:o29").Value = Arr        '将改名后数组内的值赋给单元格区域
    
66.     End If
    
67.     [h26].Activate      '激活“姓名”输入单元格
    
68. End Sub
    
69. 
    
70. Sub 删除姓名()
    
71. i = d.Keys      '观察用；关键字（姓名）集合
    
72. j = d.Items     '观察用；条目（姓名所在列数）集合
    
73. m = Arr     '观察用；数组状态
    
74.     If Range("i31").Value = "" Then Exit Sub
    
75.     s1 = d(Range("i31").Value)      '查字典
    
76.     d.Remove (Range("i31").Value)       '从字典中同时清除“错误的姓名”和这个姓名的条目（列号）
    
77.     i = d.Keys      '观察用；关键字（姓名）集合
    
78.     j = d.Items     '观察用；条目（姓名所在列数）集合
    
79.     s = s - 1    '原有候选人数（亦即原有候选人占用的列数）-1
    
80.     For t = s1 To k - 1
    
81.         Arr(1, t) = Arr(1, t + 1)       '在数组中，依次以右列候选人姓名覆盖左列候选人姓名
    
82.         Arr(2, t) = Arr(2, t + 1)       '在数组中，依次以右列候选人姓名的得票数覆盖左列候选人姓名的得票数
    
83.         m = Arr     '观察用；“覆盖”后的数组状态
    
84.         If Arr(1, t + 1) <> "" Then d(Arr(1, t + 1)) = t      '在字典中，依次将右列候选人姓名的条目数（列号）减1
    
85.         i = d.Keys      '观察用；关键字（姓名）集合
    
86.         j = d.Items     '观察用；条目（姓名所在列数）集合
    
87.     Next
    
88. Range("h28:o29").Value = Arr    '将数组内的值赋给单元格区域
    
89. Range("i31:j32").ClearContents      '清除区域中的内容
    
90. [h26].Activate      '激活“姓名”输入单元格
    
91. End Sub
    
92. 
    
93. Sub 合并姓名()
    
94.     If Range("i34").Value = "" Or Range("i35").Value = "" Then Exit Sub
    
95.     If Range("i34").Value = Range("i35").Value Then
    
96.     MsgBox "相同姓名不存在合并运算！", 48, "合并姓名"
    
97.     Range("i34:j35").ClearContents      '清除区域中的内容
    
98.     [h26].Activate      '激活“姓名”输入单元格
    
99.     Exit Sub
    
100.     End If
     
101.     s1 = d(Range("i34").Value)      '查字典
     
102.     s2 = d(Range("i35").Value)      '查字典
     
103.     Arr(2, s2) = Arr(2, s2) + Arr(2, s1)
     
104.     Range("i31").Value = Range("i34").Value
     
105.     Call 删除姓名
     
106.     Range("i34:j35").ClearContents      '清除区域中的内容
     
107.     [h26].Activate      '激活“姓名”输入单元格
     
108. End Sub
     
109. 
     
110. Sub 开始化()
     
111.     d.RemoveAll    '清除字典中全部信息
     
112.     d.CompareMode = IIf(Range("g27").Value, 1, 0)    'CompareMode等于0时区分大小写，等于1时不区分大小写
     
113.                                                      '在投票开始之前点击特定按钮，可以方便地设置g27的值为1(TRUE)或0(FALSE)
     
114.     s = 0   '为设置关键字（候选人姓名）的条目（候选人姓名所在列数）作准备
     
115.     Erase Arr    '清除数组元素，但保留空间结构
     
116.     Range("h26:k26,h28:o29,i31:j32,i34:j35").ClearContents    '清除评选表单元格区域中显示的内容
     
117.     [h26].Activate      '激活h26单元格
     
118. End Sub
     

复制代码

（欢迎批评指正）
（一直想以实际行动替代回复，发布此主题也是对没有及时回复山菊花老师的致歉。）

tony_rico

现在正在学习字典用法, 跟帖关注学习