|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub tttt()
Dim arr As Variant
Dim dic As Object: Set dic = CreateObject("scripting.dictionary")
arr = ThisWorkbook.Sheets("4月份考勤记录").Range("A2:E2").Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 5).Value
arr = ArraySortTwo(arr, 3, , 4)
ReDim Preserve arr(1 To UBound(arr, 1), 1 To UBound(arr, 2) + 1)
For i = LBound(arr, 1) To UBound(arr, 1)
AttendanceDate = Split(arr(i, 4), " ")(0)
AttendanceTime = Split(arr(i, 4), " ")(1)
arr(i, 4) = AttendanceDate
arr(i, 6) = AttendanceTime
Next
For i = LBound(arr, 1) To UBound(arr, 1)
key = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4)
dic(key) = dic(key) & "," & arr(i, 6)
Next
keys = dic.keys
items = dic.items
Dim brr As Variant: ReDim brr(1 To dic.Count, 1 To 7)
For i = LBound(keys, 1) To UBound(keys, 1)
For j = 1 To 4
brr(i + 1, j) = Split(keys(i), ",")(j - 1)
Next j
temp_time = Split(items(i), ",")
brr(i + 1, 5) = temp_time(LBound(temp_time) + 1)
brr(i + 1, 6) = temp_time(UBound(temp_time))
brr(i + 1, 7) = Round(DateDiff("n", brr(i + 1, 5), brr(i + 1, 6)) / 60, 2)
Next i
ThisWorkbook.Sheets("4月份考勤记录").Range("H2").Resize(UBound(brr, 1), UBound(brr, 2)).Value = brr
End Sub
|
|