Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1720|回复: 6

[已解决]求助把已有符合两个条件求和代码改为字典

[复制链接]
发表于 2015-11-25 18:05 | 显示全部楼层 |阅读模式
vba两条件求和.zip (8.87 KB, 下载次数: 8)
发表于 2015-11-25 18:31 | 显示全部楼层    本楼为最佳答案   
  1. Sub test()
  2. Dim d As Object, ar1, ar2, r1 As Integer, r2 As Integer, st As String
  3. Set d = CreateObject("scripting.dictionary")
  4. ar1 = Sheet2.Range("a2", Sheet2.Range("a2").End(xlDown).End(xlToRight))
  5. For r1 = 1 To UBound(ar1)
  6.     d(ar1(r1, 1) & "-" & ar1(r1, 2)) = d(ar1(r1, 1) & "-" & ar1(r1, 2)) + ar1(r1, 3)
  7. Next r1
  8. ar2 = Range("d2", Range("d2").End(xlDown).Offset(, 1))
  9. st = Range("a2")
  10. For r2 = 1 To UBound(ar2)
  11.     ar2(r2, 2) = d(ar2(r2, 1) & "-" & st)
  12. Next r2
  13. Range("d2").Resize(UBound(ar2), UBound(ar2, 2)) = ar2
  14. End Sub
复制代码

vba两条件求和.rar

13.75 KB, 下载次数: 15

回复

使用道具 举报

发表于 2015-11-25 18:41 | 显示全部楼层
  1. Sub x()
  2. Dim arr, x%, ctr$
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Sheets("数据").Range("a1").CurrentRegion
  5.      For x = 2 To UBound(arr)
  6.            ctr = arr(x, 2) & arr(x, 1)
  7.            d(ctr) = d(ctr) + arr(x, 3)
  8.      Next
  9. arr = Range("d1").CurrentRegion
  10. For x = 2 To UBound(arr)
  11.        arr(x, 2) = d([a2] & arr(x, 1))
  12. Next
  13. Range("d1").Resize(x - 1, 2) = arr
  14. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2015-11-25 18:42 | 显示全部楼层
yorkchenshunan 发表于 2015-11-25 18:31

太感谢了!这么快就给回复解决了我的问题
回复

使用道具 举报

 楼主| 发表于 2015-11-25 19:39 | 显示全部楼层
yorkchenshunan 发表于 2015-11-25 18:31

QQ图片20151125193042.png
当名称列条件中间有空格,下面的符合的条件就无法进行汇总了,烦麻再解决一下.
回复

使用道具 举报

发表于 2015-11-25 20:51 | 显示全部楼层
yiniuniu 发表于 2015-11-25 19:39
当名称列条件中间有空格,下面的符合的条件就无法进行汇总了,烦麻再解决一下.

将08行的语句改为
ar2 = Range("d2", Range("d65536").End(xlUp).Offset(, 1))
即可
回复

使用道具 举报

 楼主| 发表于 2015-11-25 21:14 | 显示全部楼层
yorkchenshunan 发表于 2015-11-25 20:51
将08行的语句改为
ar2 = Range("d2", Range("d65536").End(xlUp).Offset(, 1))
即可

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 13:45 , Processed in 1.074635 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表