楼主
kevinchengcw |
Q: 如何用vba代码获取同一人在同一天同一小时中签到的最后时间记录？
A: 代码如下：
- Sub test()
- Dim Rng As Range, Dic As Object, N&, I%, Arr, Str$, Result
- Set Dic = CreateObject("scripting.dictionary") '创建字典项目
- Set Rng = [b2] '设定数据区左上角位置,如果表格位置不固定,此处可以用find方式查找左上角特征字符单元格位置
- Arr = Range(Rng, Cells(Cells(Rows.Count, Rng.Column).End(3).Row, Cells(Rng.Row, Columns.Count).End(1).Column)).Value2 '取得表格区域数据
- ReDim Result(LBound(Arr, 2) To UBound(Arr, 2), 1 To 1) '重定义结果数组
- For N = LBound(Arr) To UBound(Arr) '循环数据区
- If Trim(Arr(N, 1)) <> "" Then '如果数据有效,则
- Str = Trim(Arr(N, 1)) & vbTab & Format(Arr(N, 4), "yyyymmddhh") '将人名与签到数据(年月日时)组合成key,保证同一人同一天同一小时里面唯一组合
- If Dic.exists(Str) Then '如果已存在该项目,进一步判断时间是否更靠后(数值更大),如果大则替换现有数据
- If Arr(N, 4) > Result(4, Dic(Str)) Then Result(4, Dic(Str)) = Arr(N, 4)
- Else '否则将当前数据行写入结果数组中
- For I = LBound(Arr, 2) To UBound(Arr, 2)
- Result(I, UBound(Result, 2)) = Arr(N, I)
- Next I
- Dic.Add Str, UBound(Result, 2) '将当前数据项内容添加到字典中
- ReDim Preserve Result(LBound(Result) To UBound(Result), LBound(Result, 2) To UBound(Result, 2) + 1) '为数组增加一列
- End If
- End If
- Next N
- With [j2] '设置输出结果区左上角单元格
- For N = LBound(Result) To UBound(Result) '利用循环输出(数量少也可用transpose方式输出)
- For I = LBound(Result, 2) To UBound(Result, 2)
- If N = 4 Then '如果是时间列,定义单元格格式后再输出
- With .Offset(I - 1, N - 1)
- .NumberFormatLocal = "yyyy/mm/dd hh:mm"
- .Value = Result(N, I)
- End With
- Else
- .Offset(I - 1, N - 1) = Result(N, I)
- End If
- Next I
- Next N
- End With
- Set Dic = Nothing '清空字典项目
- End Sub
详见附件及素材源帖.
 Demo.rar
|
要是我也会VBA就好了