Excel精英培训网

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

[已解决]按条件统计持续时间

[复制链接]
发表于 2014-10-28 19:42 | 显示全部楼层 |阅读模式
本帖最后由 ms967967 于 2014-10-29 06:52 编辑

这个VB是论坛里gdpgdp317帮助做的。
已经实现了我当时的要求, 现在又有新的要求,希望高人指点,
附件在2楼
最佳答案
2014-10-29 05:30
  1. Sub Macro1()
  2. Dim arr, brr, d, i&, j%, zf$, x&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("a1").CurrentRegion
  5. brr = Sheet1.[a1:m25]
  6. x = Sheet1.[a:a].Find([c1], lookat:=xlWhole).Row
  7. For i = 4 To x
  8.     For j = 2 To UBound(brr, 2)
  9.         z = IIf(Sheet1.Cells(i, j).Interior.ColorIndex = 44, 0.5, 1)
  10.         zf = brr(3, j) & "," & brr(i, j)
  11.         d(zf) = d(zf) + z
  12.     Next
  13. Next
  14. For i = 3 To UBound(arr)
  15.     zf = arr(i, 1) & "," & arr(i, 2)
  16.     arr(i, 3) = d(zf)
  17. Next
  18. Range("c1").Resize(UBound(arr)) = Application.Index(arr, 0, 3)
  19. End Sub
复制代码
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2014-10-28 19:43 | 显示全部楼层
按条件汇总列信息.rar (18.95 KB, 下载次数: 13)
回复

使用道具 举报

发表于 2014-10-28 20:36 | 显示全部楼层
楼主模拟的结果是否有误?应该是0.5吧
A005        戊        2
回复

使用道具 举报

发表于 2014-10-28 20:54 | 显示全部楼层
不会VBA,学习中。
回复

使用道具 举报

发表于 2014-10-29 05:30 | 显示全部楼层    本楼为最佳答案   
  1. Sub Macro1()
  2. Dim arr, brr, d, i&, j%, zf$, x&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("a1").CurrentRegion
  5. brr = Sheet1.[a1:m25]
  6. x = Sheet1.[a:a].Find([c1], lookat:=xlWhole).Row
  7. For i = 4 To x
  8.     For j = 2 To UBound(brr, 2)
  9.         z = IIf(Sheet1.Cells(i, j).Interior.ColorIndex = 44, 0.5, 1)
  10.         zf = brr(3, j) & "," & brr(i, j)
  11.         d(zf) = d(zf) + z
  12.     Next
  13. Next
  14. For i = 3 To UBound(arr)
  15.     zf = arr(i, 1) & "," & arr(i, 2)
  16.     arr(i, 3) = d(zf)
  17. Next
  18. Range("c1").Resize(UBound(arr)) = Application.Index(arr, 0, 3)
  19. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
ms967967 + 3

查看全部评分

回复

使用道具 举报

发表于 2014-10-29 05:32 | 显示全部楼层
………………

按条件汇总列信息.zip

14.55 KB, 下载次数: 9

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 17:07 , Processed in 0.561937 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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