Excel精英培训网

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

[已解决]汇总的问题

[复制链接]
发表于 2014-12-23 09:51 | 显示全部楼层 |阅读模式
本帖最后由 黑山上的鹰 于 2014-12-23 11:18 编辑

各位老师:3万行的数据汇总,遍了一个宏,不正确,急用,请指教。 2014年日消耗写实表1 - 副本.haozip01.zip (799 KB, 下载次数: 19)
发表于 2014-12-23 10:03 | 显示全部楼层
!   F:\Downloads\2014年日消耗写实表1 - 副本.haozip01.zip: 这个压缩文件格式未知或者数据已经被损坏

重新上传看看。
在保证能说清所有情况下,先上传少量数据,比如几十条数据。
回复

使用道具 举报

发表于 2014-12-23 10:21 | 显示全部楼层    本楼为最佳答案   
  1. Sub Macro1()
  2. On Error Resume Next
  3. Dim arr, brr, d, i&, j%, k%, s&
  4. Set d = CreateObject("scripting.dictionary")
  5. arr = Sheets("数据源").Range("a1").CurrentRegion
  6. ReDim brr(1 To UBound(arr), 1 To 10)
  7. For i = 3 To UBound(arr)
  8.     p = ""
  9.     For j = 4 To 10
  10.         p = p & "," & arr(i, j)
  11.     Next
  12.     If Not d.exists(p) Then
  13.         s = s + 1
  14.         d(p) = s
  15.         For k = 4 To 10
  16.             brr(s, k - 3) = arr(i, k)
  17.         Next
  18.         brr(s, 8) = arr(i, 12)
  19.         brr(s, 9) = arr(i, 13)
  20.         brr(s, 10) = arr(i, 14)
  21.     Else
  22.         n = d(p)
  23.         brr(n, 8) = brr(n, 8) + arr(i, 12)
  24.         brr(n, 10) = brr(n, 10) + arr(i, 14)
  25.     End If
  26. Next
  27. Sheets("汇总").Range("a3").Resize(s, UBound(brr, 2)) = brr
  28. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-12-23 11:11 | 显示全部楼层
dsmch 发表于 2014-12-23 10:21

很好用,谢谢,有些地方看不懂,能否注释一下。
回复

使用道具 举报

发表于 2014-12-23 11:16 | 显示全部楼层
回复

使用道具 举报

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

本版积分规则

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

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

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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