Excel精英培训网

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

[已解决]求教 用VBA根据每月打卡时间记录计算次数

[复制链接]
发表于 2016-6-24 09:46 | 显示全部楼层 |阅读模式
本帖最后由 mathking77 于 2016-6-24 11:39 编辑

求教

附件是一个月中所有人的打卡时间记录

我想计算每个人一个月中14:00之前的总次数和14:00之后的总次数
就是某某某 这个月 下午2点前一共多少次,下午两点后一共多少次
把计算的次数分别写在后面两列就行 或者重新生成张新表格也行

用VBA怎么写 求大神指教







最佳答案
2016-6-24 11:27
代码如下,结果会产生在N-P列
  1. Sub XX()
  2.     Dim arr, d, n&
  3.     Set d = CreateObject("Scripting.Dictionary")
  4.     With Sheet1
  5.         n = .Cells(.Rows.Count, 1).End(xlUp).Row
  6.         arr = .Range("A2:J" & n)
  7.         For i = 1 To n - 1
  8.             If Not d.Exists(arr(i, 7)) Then
  9.                 d.Add arr(i, 7), arr(i, 7)
  10.                 Set d(arr(i, 7)) = CreateObject("Scripting.Dictionary")
  11.             End If
  12.             If arr(i, 2) <= TimeValue("14:00:00") Then
  13.                 If d(arr(i, 7)).Exists("两点前") Then
  14.                     d(arr(i, 7))("两点前") = d(arr(i, 7))("两点前") + 1
  15.                 Else
  16.                     d(arr(i, 7))("两点前") = 1
  17.                 End If
  18.             Else
  19.                 If d(arr(i, 7)).Exists("两点后") Then
  20.                     d(arr(i, 7))("两点后") = d(arr(i, 7))("两点后") + 1
  21.                 Else
  22.                     d(arr(i, 7)).Add "两点后", 1
  23.                 End If
  24.             End If
  25.         Next
  26.         x = 1
  27.         .Cells(x, 14) = "姓名"
  28.         .Cells(x, 15) = "两点前"
  29.         .Cells(x, 16) = "两点后"
  30.         For Each k In d.keys
  31.             x = x + 1
  32.             .Cells(x, 14) = k
  33.             .Cells(x, 15) = d(k)("两点前")
  34.             .Cells(x, 16) = d(k)("两点后")
  35.         Next
  36.     End With
  37. End Sub
复制代码

5月就餐sample.rar

67.62 KB, 下载次数: 12

发表于 2016-6-24 10:50 | 显示全部楼层
见附件

5月就餐sample.rar

120.09 KB, 下载次数: 17

回复

使用道具 举报

 楼主| 发表于 2016-6-24 10:58 | 显示全部楼层
yorkchenshunan 发表于 2016-6-24 10:50
见附件

如果用VBA怎么写?
回复

使用道具 举报

发表于 2016-6-24 11:27 | 显示全部楼层    本楼为最佳答案   
代码如下,结果会产生在N-P列
  1. Sub XX()
  2.     Dim arr, d, n&
  3.     Set d = CreateObject("Scripting.Dictionary")
  4.     With Sheet1
  5.         n = .Cells(.Rows.Count, 1).End(xlUp).Row
  6.         arr = .Range("A2:J" & n)
  7.         For i = 1 To n - 1
  8.             If Not d.Exists(arr(i, 7)) Then
  9.                 d.Add arr(i, 7), arr(i, 7)
  10.                 Set d(arr(i, 7)) = CreateObject("Scripting.Dictionary")
  11.             End If
  12.             If arr(i, 2) <= TimeValue("14:00:00") Then
  13.                 If d(arr(i, 7)).Exists("两点前") Then
  14.                     d(arr(i, 7))("两点前") = d(arr(i, 7))("两点前") + 1
  15.                 Else
  16.                     d(arr(i, 7))("两点前") = 1
  17.                 End If
  18.             Else
  19.                 If d(arr(i, 7)).Exists("两点后") Then
  20.                     d(arr(i, 7))("两点后") = d(arr(i, 7))("两点后") + 1
  21.                 Else
  22.                     d(arr(i, 7)).Add "两点后", 1
  23.                 End If
  24.             End If
  25.         Next
  26.         x = 1
  27.         .Cells(x, 14) = "姓名"
  28.         .Cells(x, 15) = "两点前"
  29.         .Cells(x, 16) = "两点后"
  30.         For Each k In d.keys
  31.             x = x + 1
  32.             .Cells(x, 14) = k
  33.             .Cells(x, 15) = d(k)("两点前")
  34.             .Cells(x, 16) = d(k)("两点后")
  35.         Next
  36.     End With
  37. End Sub
复制代码
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 09:41 , Processed in 0.343412 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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