|
楼主 |
发表于 2020-7-18 12:22
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
1.字典去重+数组实现,耗时1秒内。
次数的key用arr(i, 1) & "|次",金额的key用arr(i, 1) & "|金",进行识别;然后将得到的key写入数组crr,循环crr,brr首列取得key,第二列从字典中取得次数,第三列从字典中取得金额。
- Sub 字典数组计算()
- t = Timer
- Set dic = CreateObject("Scripting.Dictionary")
- Range("D:F").ClearContents '清空D:F列内容
- arr = Range("A1:B25000") '单元格值写入数组
- ReDim brr(1 To 25001, 1 To 3) '定义数组brr空间,行数比数组arr大1,用于预防没有重复值时brr的合计行超出范围;也可以用Redim brr定义
- brr(1, 1) = "编号": brr(1, 2) = "次数": brr(1, 3) = "金额"
- On Error Resume Next
- For i = 2 To UBound(arr) '循环数组arr
- dic(arr(i, 1) & "|次") = dic(arr(i, 1) & "|次") + 1 'key添加文字“次”识别,统计同类个数
- dic(arr(i, 1) & "|金") = dic(arr(i, 1) & "|金") + arr(i, 2) 'key添加文字“金”识别,统计同类金额之和
- ' dic(arr(i, 1) & "|" & "次") = dic(arr(i, 1) & "|" & "次") + Array(1, arr(i, 2))(0)
- ' dic(arr(i, 1) & "|" & "次") = dic(arr(i, 1) & "|" & "金") + Array(1, arr(i, 2))(1)
- mysum = mysum + arr(i, 2) '累计总金额
- Next i
- Erase arr
- n = 1 '初始值
- crr = dic.keys '将key的唯一值放入数组crr
- For x = 0 To UBound(crr) '循环数组crr
- n = n + 1 '用于确定brr元素的位置,也用于确定数组brr最后有效数据的行位置
- If x * 2 > UBound(crr) Then Exit For '当x*2大于数组crr上限时,退出循环x
- brr(n, 1) = Left(crr(x * 2), Len(crr(x * 2)) - 2) '把key中的“|次"去掉,写入到brr数组第一列
- brr(n, 2) = dic(brr(n, 1) & "|" & "次") '把同类别次数写入数组brr
- brr(n, 3) = dic(brr(n, 1) & "|" & "金") '把同类别金额之和写入数组brr
- Next x
- Erase crr
- brr(n, 1) = "合计": brr(n, 2) = UBound(arr) - 1: brr(n, 3) = mysum '合计数写入数组有效行末尾
- Range("D1").Resize(n, 3) = brr '数组写入到表格中
- MsgBox Timer - t
- End Sub
复制代码
|
|