求各位前辈帮忙,多列字典汇总

chxw68 · 发表于 2019-2-21 17:20

Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
With Worksheets("发货明细")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:q" & r)
End With
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 7)) Then
Set d(arr(i, 7)) = CreateObject("scripting.dictionary")
End If
d(arr(i, 7))(arr(i, 9)) = d(arr(i, 7))(arr(i, 9)) + arr(i, 16)
Next
With Worksheets("汇总查询")
.UsedRange.Offset(1, 0).Clear
m = 2
For Each aa In d.keys
.Cells(m, 2).Resize(d(aa).Count, 2) = Application.Transpose(Array(d(aa).keys, d(aa).items))
.Cells(m + d(aa).Count, 2) = "小计"
.Cells(m + d(aa).Count, 3) = Application.Sum(d(aa).items)
With .Cells(m, 1)
.Value = aa
.Resize(d(aa).Count + 1, 1).Merge
End With
m = m + d(aa).Count + 1
Next
.Range("a1:c" & m - 1).Borders.LineStyle = xlContinuous
End With
Application.ScreenUpdating = True
MsgBox "数据汇总完毕！"
End Sub

复制代码

chxw68 · 发表于 2019-2-21 17:21

第一问代码。

wbjjzhu · 发表于 2019-2-21 17:57

路过，学习字典的用法！

chxw68 · 发表于 2019-2-21 18:07

前面忘了0值不显示这个要求了。

lkqsmxw · 发表于 2019-2-21 18:52

这样的结果就能完成你所要的结果了

jjmysjg · 发表于 2019-2-22 07:16

留下记号谢谢

feilanga · 发表于 2019-2-22 09:51

chxw68 发表于 2019-2-21 18:07
前面忘了0值不显示这个要求了。

崇拜的不要不要的. 慢慢学习,不知道啥时候能有您万一的水平

feilanga · 发表于 2019-2-22 09:52

lkqsmxw 发表于 2019-2-21 18:52
这样的结果就能完成你所要的结果了

恩,代码哪去了?谢谢老师,能把代码发一下吗?我想对比学习一下

lkqsmxw · 发表于 2019-2-22 10:25

feilanga 发表于 2019-2-22 09:52
恩,代码哪去了?谢谢老师,能把代码发一下吗?我想对比学习一下

feilanga · 发表于 2019-3-16 09:43

lkqsmxw 发表于 2019-2-22 10:25
http://club.excelhome.net/forum.php?mod=attachment&aid=MjMxNDgyNnxiNWMzODMyNHwxNTUwODAyMTAwfDM4MjM ...

此地址无法读取啊，老师。

		自动登录	找回密码
密码			免费注册

[求助] 求各位前辈帮忙,多列字典汇总