设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 汇总求和
数据透视表40+个常用小技巧，让你一次学会！
12下一页
返回列表 发新帖
查看: 4839|回复: 11

[已解决]汇总求和

[复制链接]
发表于 2015-3-19 09:25 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 依雪茗香 于 2015-3-19 11:37 编辑

如果商品名称和型号已知固定，黄色部分代码要怎么写？ VBA数组之下棋法.rar (145.73 KB, 下载次数: 8)
黄色, 型号

相关帖子
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
grf1973
发表于 2015-3-19 10:05 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
  1. Sub tt()
  2.     Dim arr, brr, d1, d2, yf%, i%, x$
  3.     arr = [a2].CurrentRegion
  4.     Set d1 = CreateObject("scripting.dictionary")
  5.     Set d2 = CreateObject("scripting.dictionary")
  6.     yf = [I1]    '月份
  7.     For i = 2 To UBound(arr)
  8.         If Month(arr(i, 1)) = yf Then
  9.             x = arr(i, 2) & "," & arr(i, 3)
  10.             d1(x) = d1(x) + arr(i, 4)
  11.             d2(x) = d2(x) + arr(i, 5)
  12.         End If
  13.     Next
  14.     brr = [h1].CurrentRegion
  15.     For i = 3 To UBound(brr)
  16.         x = brr(i, 1) & "," & brr(i, 2)
  17.         brr(i, 3) = d1(x): brr(i, 4) = d2(x)
  18.         brr(i, 5) = brr(i, 3) + Val(brr(i - 1, 5))
  19.         brr(i, 6) = brr(i, 4) + Val(brr(i - 1, 6))
  20.     Next
  21.     [h1].CurrentRegion = brr
  22. End Sub
复制代码
回复

使用道具 举报

grf1973
发表于 2015-3-19 10:06 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
请看附件。

VBA数组之下棋法.rar

151.17 KB, 下载次数: 13
回复

使用道具 举报

发表于 2015-3-19 10:13 | 显示全部楼层
  1. Sub test()
  2.     Dim d As Object, s$, arr, i%
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = [h3:i12]
  5.     For i = 1 To UBound(arr)
  6.         s = arr(i, 1) & "," & arr(i, 2)
  7.         d(s) = i
  8.     Next
  9.     ReDim brr(1 To i - 1, 1 To 4)
  10.     arr = [b3:e28]
  11.     For i = 1 To UBound(arr)
  12.         s = arr(i, 1) & "," & arr(i, 2)
  13.         If d.Exists(s) Then
  14.             brr(d(s), 1) = arr(i, 3)
  15.             brr(d(s), 2) = arr(i, 4)
  16.             brr(d(s), 3) = brr(d(s), 3) + arr(i, 3)
  17.             brr(d(s), 4) = brr(d(s), 4) + arr(i, 4)
  18.         End If
  19.     Next
  20.     [j3].Resize(UBound(brr), 4) = brr
  21. End Sub
复制代码
VBA数组之下棋法.rar (148.52 KB, 下载次数: 3)
回复

使用道具 举报

 楼主| 发表于 2015-3-19 10:20 | 显示全部楼层
grf1973 发表于 2015-3-19 10:06
请看附件。

谢谢你的回复，能解释下代码吗？月份相同时能看懂，累计数这个看不明白，CurrentRegion是定位的意思吗？brr(i, 3) = d1(x): brr(i, 4) = d2(x)这中间的：是什么意思？
回复

使用道具 举报

 楼主| 发表于 2015-3-19 10:36 | 显示全部楼层
雪舞子 发表于 2015-3-19 10:13

谢谢你的回复，如果我把月份改成1月或3月的话，计算错误。
回复

使用道具 举报

发表于 2015-3-19 10:38 | 显示全部楼层
没注意有月份限制,稍作修改添加月份判断:
  1. Sub test()
  2.     Dim d As Object, s$, arr, i%, y%
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = [h3:i12]: y = [I1]
  5.     For i = 1 To UBound(arr)
  6.         s = arr(i, 1) & "," & arr(i, 2)
  7.         d(s) = i
  8.     Next
  9.     ReDim brr(1 To i - 1, 1 To 4)
  10.     arr = [a3:e28]
  11.     For i = 1 To UBound(arr)
  12.         If Month(arr(i, 1)) = y Then
  13.             s = arr(i, 2) & "," & arr(i, 3)
  14.             If d.Exists(s) Then
  15.                 brr(d(s), 1) = arr(i, 4)
  16.                 brr(d(s), 2) = arr(i, 5)
  17.                 brr(d(s), 3) = brr(d(s), 3) + arr(i, 4)
  18.                 brr(d(s), 4) = brr(d(s), 4) + arr(i, 5)
  19.             End If
  20.         End If
  21.     Next
  22.     [j3].Resize(UBound(brr), 4) = brr
  23. End Sub
复制代码
VBA数组之下棋法.rar (148.63 KB, 下载次数: 13)
回复

使用道具 举报

 楼主| 发表于 2015-3-19 10:46 | 显示全部楼层
雪舞子 发表于 2015-3-19 10:38
没注意有月份限制,稍作修改添加月份判断:

数量
利润
累计数量
累计利润
这里的数量都一样的，能不能设置在哪个月份时，前二列显示本月的数量，后二列显示1-本月的累计数
日期商品名称型号数量利润
2015-1-1
A
A1
1
100
2015-2-1
A
A1
1
100
2015-3-1
A
A1
1
100
2015-1-1
A
A2
1
100
2015-2-1
A
A2
1
100


月份
3
商品名称
型号
数量
利润
累计数量
累计利润
公式验算
A
A1
1
100
1
100
　
回复

使用道具 举报

grf1973
发表于 2015-3-19 11:22 | 显示全部楼层    本楼为最佳答案   
  1. Sub tt()
  2.     Dim arr, brr, d, yf%, i%, n%, x$
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = [a2].CurrentRegion       '源数据区域
  5.     brr = [h1].CurrentRegion    '结果显示区域
  6.     For i = 3 To UBound(brr)         '商品名称+型号和结果显示区域的行数相对应
  7.         x = brr(i, 1) & "," & brr(i, 2)
  8.         d(x) = i
  9.     Next
  10.     yf = [I1]    '月份
  11.     For i = 2 To UBound(arr)
  12.         If Month(arr(i, 1)) <= yf Then      '月份<=指定月份
  13.             x = arr(i, 2) & "," & arr(i, 3)       '商品名称+型号
  14.             n = d(x)         '根据商品名称+型号，取得结果显示区域对应的行数
  15.             If n > 0 Then
  16.                 brr(n, 5) = brr(n, 5) + arr(i, 4)       '累计数量
  17.                 brr(n, 6) = brr(n, 6) + arr(i, 5)       '累计利润
  18.                 If Month(arr(i, 1)) = yf Then         '月份=指定月份
  19.                     brr(n, 3) = brr(n, 3) + arr(i, 4)        '数量
  20.                     brr(n, 4) = brr(n, 4) + arr(i, 5)        '利润
  21.                 End If
  22.             End If
  23.         End If
  24.     Next
  25.     [h1].CurrentRegion = brr
  26. End Sub
复制代码
回复

使用道具 举报

grf1973
发表于 2015-3-19 11:25 | 显示全部楼层
这下应该没问题了吧。要统计的量比较多，采取雪舞子的办法比较好。不然得设4个字典。

VBA数组之下棋法.rar

150.7 KB, 下载次数: 14
回复

使用道具 举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-4-20 08:31 , Processed in 0.272820 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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