|
|
在您的代码中，当判断店名不存在于日期字典时，您是将该店名及金额作为一个新的键值对写入日期字典中。然而，这样一来，您的日期字典中存放的就不再是单纯的日期键值对，而变成了键值对嵌套，即日期键对应的值是另一个店名和金额的字典。
在后续的处理中，您尝试通过日期键获取对应的嵌套字典，并从嵌套字典中取出店铺对应的金额值。但由于日期键对应的值已经不再是普通的金额了，而是另一个字典，因此会导致无法正常累加金额。
解决这个问题的方法是，将日期键对应的值设为另一个字典，用来存放店名及其对应的金额。修改代码如下：
Sub 测试汇总()
Set d = CreateObject("scripting.dictionary")
Set dic = CreateObject("scripting.dictionary") '必要的
arr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
If Not dic.exists(arr(i, 2)) Then
Set dic(arr(i, 2)) = CreateObject("scripting.dictionary") '日期字典
End If
If Not dic(arr(i, 2)).exists(arr(i, 1)) Then '判断是否存在嵌套的字典中
dic(arr(i, 2))(arr(i, 1)) = Val(arr(i, 3)) '如果不存在，将店名作为键值写入日期的字典中作为键，值为对应的金额
Else
dic(arr(i, 2))(arr(i, 1)) = dic(arr(i, 2))(arr(i, 1)) + Val(arr(i, 3)) '如果存在，将值进行累加
End If
d(arr(i, 1)) = "" '店名
Next i
[a18].CurrentRegion.ClearContents
[a18] = "日期"
[a19].Resize(dic.Count, 1) = Application.Transpose(dic.keys) '日期去重复
[b18].Resize(1, d.Count) = Application.Transpose(Application.Transpose(d.keys)) '店名去重复
brr = [a18].CurrentRegion
For i = 2 To UBound(brr)
For j = 2 To UBound(brr, 2)
brr(i, j) = dic(brr(i, 1))(brr(1, j))
Next
Next
[a18].CurrentRegion = brr
End Sub
在这个修改后的代码中，我们首先检查日期字典中是否已存在日期键，如果不存在就向字典中添加该键，并将其对应的值设为另一个字典。然后再判断店名是否存在于日期字典内的子字典中。如不存在，则创建新的店名及其金额键值对，否则直接从嵌套字典中取出店名对应的金额值进行累加。这样一来，嵌套字典就只会出现在日期字典内，而不会再出现在店名字典中了。 |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-4-4 00:59
楼主
