考勤记录纵向转横向

saiwet

求助：公司考勤记录为纵向，现需转为横向，以方便按部门、按人员进行审核和查询，由于人员较多，须用VBA进行数据处理（另，我公司办公软件用的是office 2003），请求老师们予以帮助（由于本人在VBA方面属于小白，请在主要程序后面予以标注），谢谢。

wangfeng2015

2010以上的话，直接使用power query来完成；2010以下的话，使用transform+pivot来完成
你的表我用的代码为：transform AVG(时刻) SELECT 部门,姓名,工号,日期 from [原表$] Group by 部门,姓名,工号,日期 pivot 辅助check"

效果如下：

saiwet

学习了，谢谢您的方案。但仍希望用VBA解决。

saiwet

wangfeng2015 发表于 2019-4-2 22:08
2010以上的话，直接使用power query来完成；2010以下的话，使用transform+pivot来完成
你的表我用的代码为 ...

学习了，学习您的方案

dengxingchang

可以用透视表，时间显示稍微有点不同，不过也差不多

Datous

saiwet 发表于 2019-4-2 23:31
学习了，谢谢您的方案。但仍希望用VBA解决。

一直到时间20、时间30，这样的格式吗？
那每个人最多有多少个时间？

saiwet

Datous 发表于 2019-4-3 10:39
一直到时间20、时间30，这样的格式吗？
那每个人最多有多少个时间？

每个人每天通常有6条打卡记录，但有重复打卡的情况

saiwet

dengxingchang 发表于 2019-4-3 01:11
可以用透视表，时间显示稍微有点不同，不过也差不多

透视表是能够解决，但只需要VBA的解决方案。谢谢

Datous

saiwet 发表于 2019-4-3 11:06
透视表是能够解决，但只需要VBA的解决方案。谢谢

没排错。先看看行不行。

1. Private Sub CommandButton1_Click()
   
2. Dim vntD, A&, vntRslt()
   
3. Dim dicJobDate As Object, strJobDate$
   
4. Dim lngNums&(), lngIncrNum&, lngCurrNum&
   
5. 
   
6. vntD = Sheets("sheet1").Range([A2], [D50000].End(xlUp))
   
7. Set dicJobDate = CreateObject("scripting.dictionary")
   
8. 
   
9. For A = 1 To UBound(vntD)
   
10.     strJobDate = vntD(A, 3) & "|" & Format(vntD(A, 4), "yyyy/mm/dd")
    
11.     If Not dicJobDate.exists(strJobDate) Then
    
12.         lngIncrNum = dicJobDate.Count
    
13.         dicJobDate(strJobDate) = lngIncrNum
    
14.         ReDim Preserve vntRslt(13, lngIncrNum), lngNums(lngIncrNum)
    
15.         lngNums(lngIncrNum) = 1
    
16.         vntRslt(0, lngIncrNum) = vntD(A, 1)
    
17.         vntRslt(1, lngIncrNum) = vntD(A, 2)
    
18.         vntRslt(2, lngIncrNum) = vntD(A, 3)
    
19.         vntRslt(3, lngIncrNum) = CDate(Format(vntD(A, 4), "yyyy/mm/dd"))
    
20.         vntRslt(4, lngIncrNum) = TimeValue(vntD(A, 4))
    
21.     Else
    
22.         lngCurrNum = dicJobDate(strJobDate)
    
23.         lngNums(lngCurrNum) = lngNums(lngCurrNum) + 1
    
24.         vntRslt(3 + lngNums(lngCurrNum), lngCurrNum) = TimeValue(vntD(A, 4))
    
25.     End If
    
26. Next
    
27. Sheets("sheet2").Range("A2").Resize(lngIncrNum + 1, 14) = Application.WorksheetFunction.Transpose(vntRslt)
    
28. End Sub

复制代码

wangfeng2015

saiwet 发表于 2019-4-2 23:31
学习了，谢谢您的方案。但仍希望用VBA解决。

我用的就是VBA+ADO+SQL啊