|
有朋友（就是上次所说的貌美如如花的那位）说我们可以玩个点播台，每期插播一首音乐。额米豆腐，贫……在下也觉得甚好啊……那先来一首寂寞沙洲冷吧~  这是VBA编程经常需要处理的也是工作中常见的问题：条件计数（考试次数）和条件求和（考试成绩）。 那么——可能有的小伙伴代码是这么写的： Sub Dicttl1() Dim d As Object, arr, brr, i& Set d = CreateObject('scripting.dictionary') '后期字典 'd.CompareMode = vbTextCompare '不区分字母大小写 arr = Range('a1:b' & Cells(Rows.Count, 1).End(xlUp).Row) '数据源装入数组arr For i = 1 To UBound(arr) '遍历数据源，累加姓名成绩 d(arr(i, 1)) = d(arr(i, 1)) Val(arr(i, 2)) 'val函数提取纯数值，如果是纯文本值则计算为0，避免文本值数学运算出错 '如果是重复值计数，可以改成如下： 'd(arr(i, 1)) = d(arr(i, 1)) 1 Next brr = Range('d1:f' & Cells(Rows.Count, 4).End(xlUp).Row) '查询区域装入数组brr For i = 2 To UBound(brr) If d.exists(brr(i, 1)) Then '如果字典中存在查询的姓名,则提取总成绩 brr(i, 3) = d(brr(i, 1)) Else '否则返回空文本'' brr(i, 3) = '' End If Next With Range('d1:f' & Cells(Rows.Count, 4).End(xlUp).Row) .NumberFormat = '@' '设置文本格式，防止某些文本数值数据变形 .Value = brr 'brr数组放回单元格区域 End With Set d = Nothing '释放字典 MsgBox '合计成绩统计完成。' End Sub 该段代码只是解决了条件求和的问题，至于同时条件计数……有的朋友可能再声明一个字典……或再写一段代码…… 当然，该问题使用两个字典的方法也无不可，只是，如果还需要统计其它字段，例如考试成绩明细、最大分、最小分等等……难不成再声明第3~4~5个字典吗？ ——怕啥子呦？想想好像也可以…… ……不开玩笑了……前段时间我们说数组 字典是VBA处理数据的最佳利器，可能有些小伙伴对这句话的认识暂时就先停留在上面的代码上，数组单纯的读取单元格数据，字典单纯的存放统计结果，但其实数组和字典的关系可以更紧密些…… 比如该示例问题，我们可以声明一个n行3列的数组（crr）用于存放统计结果，第1列存放人名（可以省略），第2列存放考试累加次数，第3列存放考试累加成绩……然后通过字典将该数组和数据源及查询区域关三者联起来…… 这么说似乎让人难以理解，代码如下（注意注释）： Sub Dicttl2() Dim d As Object, arr, brr, crr, i&, j, k& Set d = CreateObject('scripting.dictionary') '后期字典 'd.CompareMode = vbTextCompare '不区分字母大小写 arr = Range('a1:b' & Cells(Rows.Count, 1).End(xlUp).Row) '数据源装入数组arr ReDim crr(1 To UBound(arr), 1 To 3) '声明数组crr放置数据统计结果。1列姓名2列次数3列总成绩。姓名列可以省略。 For i = 1 To UBound(arr) '先遍历数据源arr If Not d.exists(arr(i, 1)) Then '如果字典中不存在姓名…… k = k 1 '累加不重复人名个数，可以先理解成人名在数组crr中的序列号 d(arr(i, 1)) = k '将数组crr中的序列位置作为item装入字典，以便以后根据人名读取处理 crr(k, 1) = arr(i, 1) '姓名 crr(k, 2) = 1 '考试次数 crr(k, 3) = Val(arr(i, 2)) '考试成绩。val函数提取纯数值，如果是纯文本值则计算为0，该函数可以避免文本值数学运算时出错。 Else '如果字典中存在相关人名 j = d(arr(i, 1)) '读取人名在数组crr中的序列号 crr(j, 2) = crr(j, 2) 1 '原次数 1 crr(j, 3) = crr(j, 3) Val(arr(i, 2)) '累加成绩 End If Next ' brr = Range('d1:f' & Cells(Rows.Count, 4).End(xlUp).Row) '查询区域装入数组brr For i = 2 To UBound(brr) If d.exists(brr(i, 1)) Then '如果字典中存在查询的姓名 j = d(brr(i, 1)) '姓名在数组brr中的序列号 brr(i, 2) = crr(j, 2) '考试次数 brr(i, 3) = crr(j, 3) '总成绩 Else '否则返回空文本'' brr(i, 2) = '' brr(i, 3) = '' End If Next With Range('d1:f' & Cells(Rows.Count, 4).End(xlUp).Row) .NumberFormat = '@' '设置文本格式，防止某些文本数值数据变形 .Value = brr 'brr数组放回单元格区域 End With Set d = Nothing '释放字典 MsgBox '数据统计完成。' End Sub 小贴士： 1，字典之所以简单又强大，不仅在于它超高的数据处理效率，更在于它可以通过key键及对应项item将多个来源的数据（通常是数组）有机关联起来，使复杂的数据查询与统计变得条理清晰易如反掌。 |
|
|
