分类汇总的提取问题

求学的新手

大神我想把分类汇总的结果单独提取出来放到同张表格的L和M列
Sub aa()
Dim i, arr, d As Object
Set d = CreateObject("Scripting.Dictionary")
arr = Range("A1").CurrentRegion
For i = 2 To UBound(arr)
If arr(i, 1) Like "*汇总*" Then
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 3)
End If
Next i
Range("L2:M100").ClearContents
[L2].Resize(d.Count, 1) = Application.Transpose(d.keys)
[M2].Resize(d.Count, 1) = Application.Transpose(d.items)
Range("L1") = "航班"
Range("M1") = "销售额"

End Sub
为什么我复制过来的销售额是0而不是数值呢?求解,该如何修改

zhaojiaoyang200

请上传附件。

求学的新手

这是附件麻烦查看

求学的新手

zhaojiaoyang200 发表于 2013-12-6 23:33
请上传附件。

已经上传麻烦查看或者你有什么好的建议也行.换个程序只要目的能达到就行了谢谢

zhaojiaoyang200

Sub aa()
Dim i, arr, d As Object
Set d = CreateObject("Scripting.Dictionary")
arr = Range("A1").CurrentRegion
For i = 2 To UBound(arr)
If arr(i, 1) Like "*汇总*" Then
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 5)
End If
Next i
Range("L2:M100").ClearContents
[L2].Resize(d.Count, 1) = Application.Transpose(d.keys)
[M2].Resize(d.Count, 1) = Application.Transpose(d.items)
Range("L1") = "航班"
Range("M1") = "销售额"

End Sub

求学的新手

zhaojiaoyang200 发表于 2013-12-7 00:02
Sub aa()
Dim i, arr, d As Object
Set d = CreateObject("Scripting.Dictionary")

OK成功拉万分感谢大神,大神还有个问题请教如果我要把汇总和最后的总计都放入L和M列该如何写啊
If arr(i, 1) Like "*汇总*" Or Like "总计"说我语法不对求解

zhaojiaoyang200

少了变量，表达式错误
arr(i, 1) Like "*汇总*" Or arr(i, 1) Like "总计"

求学的新手

zhaojiaoyang200 发表于 2013-12-7 11:19
少了变量，表达式错误
arr(i, 1) Like "*汇总*" Or arr(i, 1) Like "总计"

大哥你真是我的救星啊,再问个小问题哦我有7张表格,每张数据里都是分2部分我用红和黄色区分,如何把7张表格里红色的部分保存在1张新的表格里,7张表格里黄色的部分保存在另1张新的表格里

zhaojiaoyang200

求学的新手 发表于 2013-12-7 11:31
大哥你真是我的救星啊,再问个小问题哦我有7张表格,每张数据里都是分2部分我用红和黄色区分,如何把7张表格 ...

请上附件，有利于大家帮你解决问题。

求学的新手

红色和黄色区域只是为了方便理解不能做为VBA里的判别条件