考勤统计

sunying2194

求高手帮忙，能否根据考勤机导出的原始记录，实现我的需求，附件是考勤刷卡记录数据及需求样表，在线跪求高手出手 1、刷卡时间横向显示（上表“刷卡时间”区域）。

2、全天没有打卡记录，也要显示日期（如：7月5-8号）。

3、日期要连续显示1-31号。

4、对于没有刷卡记录的人员，也要显示全月日期。 详情请见附件

詠○~振

您好，您的问题很复杂，解决不了！

uynayna

Sub test()
  Dim r%, i%, ks%, j%, m%, n%
  Dim arr, brr
  Dim d As Object
  Dim d1 As Object
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Set d = CreateObject("scripting.dictionary")
  Set d1 = CreateObject("scripting.dictionary")
    With Worksheets("原始记录")
        r = .Range("d65536").End(xlUp).Row
        arr = .Range("d8:h" & r)
    End With
    For i = 1 To UBound(arr)
        d(arr(i, 2) & arr(i, 3) & arr(i, 4)) = d(arr(i, 2) & "/" & arr(i, 3) & "/" & arr(i, 4)) + 1
    Next
    k = d.keys
    ks = d.Count - 1
    ReDim brr(1 To ks * 31, 1 To 13)
    n = 0
    For j = 0 To ks - 1
        aa = k(j)
        m = j * ks
        For tim = 42917 To 42947
           n = n + 1
           brr(m + n, 2) = Mid(aa, 1, Application.Find("/", aa) - 1)
           brr(m + n, 3) = Mid(aa, Application.Find("/", aa) + 1, Application.Find("/", aa, Application.Find("/", aa) + 1) - Application.Find("/", aa) - 1)
           brr(m + n, 1) = Mid(aa, Application.Find("/", aa, Application.Find("/", aa) + 1) + 1, 5)
           brr(m + n, 6) = Application.Text(tim, "yyyy-MM-dd")
        Next
    Next
    For i = 1 To UBound(brr)
        d1(brr(i, 2) & brr(i, 3) & brr(i, 1) & brr(i, 6)) = d1(brr(i, 2) & brr(i, 3) & brr(i, 1) & brr(i, 6)) + 1
    Next
    kkk = d1.keys
    For Each dd In d1.keys
           h = h + 1
           n1 = 0
        For i = 1 To UBound(arr)
             If dd = arr(i, 2) & arr(i, 3) & arr(i, 4) & Application.Text(arr(i, 5), "yyyy-MM-dd") Then
                     n1 = n1 + 1
                     brr(h, n1 + 7) = Mid(Application.Text(arr(i, 5), "yyyy-MM-dd:hh:mm:ss"), 12, 8)
             End If
        Next
    Next
Sheet2.Range("a3:l300").ClearContents
Sheet2.Range("a3").Resize(31, 13) = brr
End Sub