用VBA宏实现指纹原始记录按每个日期一行的方式显示出来

sunnycare_

如表所示，表1为 考勤机导出来的原始记录，现想实现如下功能：
1.新建表2，根据表1的数据，按每人每个日期一行的方式，把一个人一天多次的指纹记录都放在同一行上
2.表1的数据是有打卡才有显示，但表2希望按当月自然顺序排列，没打卡的日期显示为空行

请各位高手帮忙，谢谢~~~~

蓝桥玄霜

1. Sub lqxs()
   
2. Dim Arr, i&, x, y, kk, tt, j&, aa
   
3. Dim d, k, t, b, m&, Brr
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Sheet2.Activate
   
6. [a2:e50000].ClearContents
   
7. [a2:e50000].Borders.LineStyle = xlNone
   
8. nf = 2015: yf = 8
   
9. dd = Day(DateSerial(nf, yf + 1, 0))
   
10. Arr = Sheet1.[a1].CurrentRegion
    
11. For i = 2 To UBound(Arr)
    
12.     x = Arr(i, 1) & "," & Arr(i, 2): rq = Arr(i, 3)
    
13.     rq = Left(rq, Len(rq) - 1)
    
14.     b = Split(rq, "-")
    
15.     y = DateSerial(b(0), b(1), b(2))
    
16.     If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")
    
17.     d(x)(y) = d(x)(y) & Arr(i, 4) & " "
    
18. Next
    
19. k = d.keys: t = d.items
    
20. For i = 0 To UBound(k)
    
21.     kk = t(i).keys: tt = t(i).items
    
22.     m = Cells(Rows.Count, 1).End(xlUp).Row + 1
    
23.     Cells(m, 1).Resize(dd, 1) = k(i)
    
24.     For j = 1 To dd
    
25.         Cells(m + j - 1, 3) = DateSerial(nf, yf, j)
    
26.         Cells(m + j - 1, 4) = Format(Cells(m + j - 1, 3).Value, "[$-804]aaaa")
    
27.     Next
    
28.     Brr = Cells(m, 1).Resize(dd, 3)
    
29.     For j = 1 To UBound(Brr)
    
30.         x = Brr(j, 1): y = Brr(j, 3)
    
31.         If d(x).exists(y) Then Cells(m + j - 1, 5) = d(x)(y)
    
32.     Next
    
33. Next
    
34. m = Cells(Rows.Count, 1).End(xlUp).Row
    
35. [a2].Resize(m - 1, 1).TextToColumns DataType:=xlDelimited, Comma:=True
    
36. [a1].CurrentRegion.Borders.LineStyle = 1
    
37. End Sub
    

复制代码

蓝桥玄霜

请见附件。

sunnycare_

蓝桥玄霜 发表于 2015-9-24 20:06
请见附件。

好强大！非常感谢~~~