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

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 多重条件分类统计，请各位老师帮忙，谢谢！！！
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 2567|回复: 8

[已解决]多重条件分类统计，请各位老师帮忙，谢谢！！！

[复制链接]
发表于 2015-1-20 23:58 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
需要实现的目标：统计各个部门在不同分类业务上，各年的累计（从本年开始到之前有记录的年份开始）“业务计数”和“业务金额之和”。
请各位老师帮忙，谢谢！！！

最佳答案
月排行榜 / 总排行榜
芐雨
2015-1-21 09:49
本帖最后由 芐雨 于 2015-1-23 19:53 编辑
  1. Sub 按钮1_Click()
  2.     Dim arr, brr, dic As Object
  3.     Dim s1$, s$, i&, x&, n&
  4.     Dim tim1 As Date, tim2 As Date: tim1 = Timer

  6.     Application.ScreenUpdating = False   '禁刷新

  8.     arr = Sheets("资料").Range("A1").CurrentRegion  '数组arr

  10.     ReDim brr(1 To 10000, 1 To 7)                   '创建数组brr
  11.     Set dic = CreateObject("scripting.dictionary")  '创建字典dic

  13.     For i = 2 To UBound(arr)           '遍历数组arr
  14.         s1 = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)    '以“部门|业务分类|年份”汇总
  15.         n = dic(s1)
  16.         If n = 0 Then    ' 等于，s1不在字典中
  17.             x = x + 1     '计数，在brr的行数
  18.             dic(s1) = x   '记入字典
  19.             brr(x, 1) = arr(i, 1)  '部门
  20.             brr(x, 2) = arr(i, 2)  '业务分类
  21.             brr(x, 3) = arr(i, 3)  '年份
  22.             brr(x, 6) = 1          '次数
  23.             brr(x, 7) = arr(i, 4)  '金额
  24.         Else                       'n<>0,s1在字典中，n=dic(s1)返回brr的行数
  25.             brr(n, 6) = 1 + brr(n, 6)    '次数累加
  26.             brr(n, 7) = arr(i, 4) + brr(n, 7)   '金额累加
  27.         End If
  28.     Next
  29.     Sheets("统计结果").[B:B].NumberFormat = "@"  '格式设置为文本
  30.     With Sheets("统计结果").Range("A2")
  31.         .Offset(-1).CurrentRegion.Offset(1).ClearContents    '清除内容
  32.         .Resize(x, 7) = brr                              '写入

  34.         Call ArrSort(.CurrentRegion, [A1], [B1], [C1])  '排序，范围：.CurrentRegion。排序的主次：部门，业务分类，年份

  36.         brr = .CurrentRegion.Offset(1)   '排序后brr,Offset(1)向下偏移了一行
  37.         For i = 1 To UBound(brr) - 1
  38.             s1 = brr(i, 1) & "|" & brr(i, 2)   '部门|业务分类记为s1
  39.             s2 = brr(i + 1, 1) & "|" & brr(i + 1, 2)    '下一行的记为s2
  40.             sum1 = sum1 + brr(i, 6)                    '次数累加
  41.             sum2 = sum2 + brr(i, 7)                   '金额累加
  42.             brr(i, 4) = sum1                '本年本分类累计次数
  43.             brr(i, 5) = sum2                '本年本分类累计金额
  44.             If s1 <> s2 Then sum1 = 0: sum2 = 0  '不相同时，初始化
  45.         Next

  47.         .Resize(x, 7) = brr             '再次写入
  48.         Call ArrSort(.CurrentRegion, [A1], [C1], [B1])    '排序，排序的主次：部门，年份，业务分类
  49.         brr = .CurrentRegion.Offset(1)   '排序后brr,Offset(1)向下偏移了一行
  50.         For i = 1 To UBound(brr) - 1
  51.             s1 = brr(i, 1)         '部门记为s1
  52.             s2 = brr(i + 1, 1)     '下一行的记为s2
  53.             sum1 = sum1 + brr(i, 6)   '本年全部分类累计次数
  54.             sum2 = sum2 + brr(i, 7)   '本年全部分类累计金额
  55.             brr(i, 6) = sum1
  56.             brr(i, 7) = sum2
  57.             If s1 <> s2 Then sum1 = 0: sum2 = 0   '不相同时，初始化
  58.         Next

  60.         '因为会出现年份相同的，应该以行数大的为准
  61.         For i = UBound(brr) - 1 To 1 Step -1
  62.             s1 = brr(i, 1) & "|" & brr(i, 3)    '部门|年份记为s1
  63.             s2 = brr(i + 1, 1) & "|" & brr(i + 1, 3)  '下一行的记为s2
  64.             If s1 = s2 Then brr(i, 6) = brr(i + 1, 6): brr(i, 7) = brr(i + 1, 7)    '相等时，更新数值
  65.         Next
  66.         .Resize(x, 7) = brr
  67.     End With

  69.     Application.ScreenUpdating = True   '刷新
  70.     tim2 = Timer
  71.     MsgBox Format(tim2 - tim1, "程序执行时间为：0.00秒"), 64, "时间统计"
  72. End Sub
  73. Sub ArrSort(rng, ky1, ky2, ky3)  '排序，可录制宏学习
  74.     With rng.Parent.Sort
  75.         .SortFields.Clear
  76.         .SortFields.Add Key:=ky1, _
  77.                         SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  78.         .SortFields.Add Key:=ky2, _
  79.                         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  80.         .SortFields.Add Key:=ky3, _
  81.                         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  82.         .SetRange rng
  83.         .Header = xlYes
  84.         .MatchCase = False
  85.         .Orientation = xlTopToBottom
  86.         .SortMethod = xlPinYin
  87.         .Apply
  88.     End With
  89. End Sub
复制代码
附件：
多重分类统计.zip (204.87 KB, 下载次数: 36)
统计, 记录

多重分类统计.rar

12.5 KB, 下载次数: 18

多重分类统计.rar

相关帖子
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
发表于 2015-1-21 09:02 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
数据透视1.gif
数据透视2.gif
回复

使用道具 举报

芐雨
发表于 2015-1-21 09:49 | 显示全部楼层    本楼为最佳答案   
工作中最常用的Excel函数公式，全印在一张鼠标垫上
本帖最后由 芐雨 于 2015-1-23 19:53 编辑
  1. Sub 按钮1_Click()
  2.     Dim arr, brr, dic As Object
  3.     Dim s1$, s$, i&, x&, n&
  4.     Dim tim1 As Date, tim2 As Date: tim1 = Timer

  6.     Application.ScreenUpdating = False   '禁刷新

  8.     arr = Sheets("资料").Range("A1").CurrentRegion  '数组arr

  10.     ReDim brr(1 To 10000, 1 To 7)                   '创建数组brr
  11.     Set dic = CreateObject("scripting.dictionary")  '创建字典dic

  13.     For i = 2 To UBound(arr)           '遍历数组arr
  14.         s1 = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)    '以“部门|业务分类|年份”汇总
  15.         n = dic(s1)
  16.         If n = 0 Then    ' 等于，s1不在字典中
  17.             x = x + 1     '计数，在brr的行数
  18.             dic(s1) = x   '记入字典
  19.             brr(x, 1) = arr(i, 1)  '部门
  20.             brr(x, 2) = arr(i, 2)  '业务分类
  21.             brr(x, 3) = arr(i, 3)  '年份
  22.             brr(x, 6) = 1          '次数
  23.             brr(x, 7) = arr(i, 4)  '金额
  24.         Else                       'n<>0,s1在字典中，n=dic(s1)返回brr的行数
  25.             brr(n, 6) = 1 + brr(n, 6)    '次数累加
  26.             brr(n, 7) = arr(i, 4) + brr(n, 7)   '金额累加
  27.         End If
  28.     Next
  29.     Sheets("统计结果").[B:B].NumberFormat = "@"  '格式设置为文本
  30.     With Sheets("统计结果").Range("A2")
  31.         .Offset(-1).CurrentRegion.Offset(1).ClearContents    '清除内容
  32.         .Resize(x, 7) = brr                              '写入

  34.         Call ArrSort(.CurrentRegion, [A1], [B1], [C1])  '排序，范围：.CurrentRegion。排序的主次：部门，业务分类，年份

  36.         brr = .CurrentRegion.Offset(1)   '排序后brr,Offset(1)向下偏移了一行
  37.         For i = 1 To UBound(brr) - 1
  38.             s1 = brr(i, 1) & "|" & brr(i, 2)   '部门|业务分类记为s1
  39.             s2 = brr(i + 1, 1) & "|" & brr(i + 1, 2)    '下一行的记为s2
  40.             sum1 = sum1 + brr(i, 6)                    '次数累加
  41.             sum2 = sum2 + brr(i, 7)                   '金额累加
  42.             brr(i, 4) = sum1                '本年本分类累计次数
  43.             brr(i, 5) = sum2                '本年本分类累计金额
  44.             If s1 <> s2 Then sum1 = 0: sum2 = 0  '不相同时，初始化
  45.         Next

  47.         .Resize(x, 7) = brr             '再次写入
  48.         Call ArrSort(.CurrentRegion, [A1], [C1], [B1])    '排序，排序的主次：部门，年份，业务分类
  49.         brr = .CurrentRegion.Offset(1)   '排序后brr,Offset(1)向下偏移了一行
  50.         For i = 1 To UBound(brr) - 1
  51.             s1 = brr(i, 1)         '部门记为s1
  52.             s2 = brr(i + 1, 1)     '下一行的记为s2
  53.             sum1 = sum1 + brr(i, 6)   '本年全部分类累计次数
  54.             sum2 = sum2 + brr(i, 7)   '本年全部分类累计金额
  55.             brr(i, 6) = sum1
  56.             brr(i, 7) = sum2
  57.             If s1 <> s2 Then sum1 = 0: sum2 = 0   '不相同时，初始化
  58.         Next

  60.         '因为会出现年份相同的，应该以行数大的为准
  61.         For i = UBound(brr) - 1 To 1 Step -1
  62.             s1 = brr(i, 1) & "|" & brr(i, 3)    '部门|年份记为s1
  63.             s2 = brr(i + 1, 1) & "|" & brr(i + 1, 3)  '下一行的记为s2
  64.             If s1 = s2 Then brr(i, 6) = brr(i + 1, 6): brr(i, 7) = brr(i + 1, 7)    '相等时，更新数值
  65.         Next
  66.         .Resize(x, 7) = brr
  67.     End With

  69.     Application.ScreenUpdating = True   '刷新
  70.     tim2 = Timer
  71.     MsgBox Format(tim2 - tim1, "程序执行时间为：0.00秒"), 64, "时间统计"
  72. End Sub
  73. Sub ArrSort(rng, ky1, ky2, ky3)  '排序，可录制宏学习
  74.     With rng.Parent.Sort
  75.         .SortFields.Clear
  76.         .SortFields.Add Key:=ky1, _
  77.                         SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  78.         .SortFields.Add Key:=ky2, _
  79.                         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  80.         .SortFields.Add Key:=ky3, _
  81.                         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  82.         .SetRange rng
  83.         .Header = xlYes
  84.         .MatchCase = False
  85.         .Orientation = xlTopToBottom
  86.         .SortMethod = xlPinYin
  87.         .Apply
  88.     End With
  89. End Sub
复制代码
附件：
多重分类统计.zip (204.87 KB, 下载次数: 36)
回复

使用道具 举报

 楼主| 发表于 2015-1-22 00:24 | 显示全部楼层
JLxiangwei 发表于 2015-1-21 09:02

谢谢版主老师，我的数据总共有9000多条，还是希望用VBA比较好点，不过还是要谢谢你的帮助。
回复

使用道具 举报

 楼主| 发表于 2015-1-22 00:27 | 显示全部楼层
芐雨 发表于 2015-1-21 09:49
附件：

谢谢这位老师，我用附件的数据跑了一下，非常好，非常感谢。我全部的数据有9000多条，明天我到单位在用大的数据跑一下，如果有问题再向您请教，再次感谢{:1112:}
回复

使用道具 举报

 楼主| 发表于 2015-1-22 21:46 | 显示全部楼层
芐雨 发表于 2015-1-21 09:49
附件：

感谢老师！！！我把1000改成了10000，可以跑全部的数据了，不过程序的语句还是看不大懂，能不能麻烦您把程序注释一下，我学习一下，论坛的其他小白也会感激您的，谢谢啦{:1612:}{:1312:}
回复

使用道具 举报

 楼主| 发表于 2015-1-23 00:26 | 显示全部楼层
芐雨 发表于 2015-1-21 09:49
附件：

老师您好，刚才我在使用正式数据做分析的时候发现，“本年本分类累计次数”这一列 我需要的是“某部门在某类业务上，截至某年累计共做了多少笔业务。”，您计算的是“某部门在某类业务上，在某年共计做了多少笔业务（是当年计数，不是由最初到本年的累计数）。”，所以结果不对，能否请老师在帮忙修改一下，代码我具体看不大懂，谢谢啦{:1612:}
回复

使用道具 举报

芐雨
发表于 2015-1-23 19:55 | 显示全部楼层
richalken 发表于 2015-1-23 00:26
老师您好，刚才我在使用正式数据做分析的时候发现，“本年本分类累计次数”这一列 我需要的是“某部门在某 ...

错误已修正，你再测试一下
里面再加了个SQL查询的方法，不过数据量大会比较慢

回复

使用道具 举报

 楼主| 发表于 2015-1-23 23:33 | 显示全部楼层
芐雨 发表于 2015-1-23 19:55
错误已修正，你再测试一下
里面再加了个SQL查询的方法，不过数据量大会比较慢

非常感谢老师，运行效果很好，高手{:1112:}{:1112:}{:1112:}
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-5-4 21:02 , Processed in 0.323231 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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