有朋友(就是上次所说的貌美如如花的那位)说我们可以玩个点播台,每期插播一首音乐。额米豆腐,贫……在下也觉得甚好啊……那先来一首寂寞沙洲冷吧~
上期我们留了一道练手题(点击阅读原文可以下载示例文件),如下图所示,根据A:B列的数据,计算D列人员的考试次数和考试成绩。这是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将多个来源的数据(通常是数组)有机关联起来,使复杂的数据查询与统计变得条理清晰易如反掌。
联系客服