[已解决]数据汇总

李子鑫

想把打卡记录、外出单、休假加班的数据，先后优先选择顺序为：打卡记录、休假加班、外出单里的数据汇总至“汇总”里面，请高手指点，谢谢了！

最佳答案

月排行榜 / 总排行榜

dsmch

2016-7-5 09:34

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1:j" & Sheet1.Range("a65536").End(xlUp).Row)
   
5. brr = Sheet2.Range("a1").CurrentRegion
   
6. crr = Sheet3.Range("a1").CurrentRegion
   
7. s = 1
   
8. For i = 2 To UBound(arr)
   
9.     zf = arr(i, 1) & "," & arr(i, 2)
   
10.     If Not d.exists(zf) Then s = s + 1: d(zf) = s
    
11. Next
    
12. For i = 2 To UBound(brr)
    
13.     zf = brr(i, 1) & "," & brr(i, 2)
    
14.     If d.exists(zf) Then
    
15.         n = d(zf)
    
16.         For j = 4 To 7
    
17.             If brr(i, j) <> "" And arr(n, j) = "" Then arr(n, j) = brr(i, j)
    
18.         Next
    
19.     End If
    
20. Next
    
21. For i = 2 To UBound(crr)
    
22.     zf = crr(i, 1) & "," & crr(i, 2)
    
23.     If d.exists(zf) Then
    
24.         n = d(zf)
    
25.         For j = 8 To 10
    
26.             If crr(i, j) <> "" And arr(n, j) = "" Then arr(n, j) = crr(i, j)
    
27.         Next
    
28.     End If
    
29. Next
    
30. Sheet4.Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
31. Sheet2.Rows(1).Copy Sheet4.[a1]
    
32. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1:j" & Sheet1.Range("a65536").End(xlUp).Row)
   
5. brr = Sheet2.Range("a1").CurrentRegion
   
6. crr = Sheet3.Range("a1").CurrentRegion
   
7. s = 1
   
8. For i = 2 To UBound(arr)
   
9.     zf = arr(i, 1) & "," & arr(i, 2)
   
10.     If Not d.exists(zf) Then s = s + 1: d(zf) = s
    
11. Next
    
12. For i = 2 To UBound(brr)
    
13.     zf = brr(i, 1) & "," & brr(i, 2)
    
14.     If d.exists(zf) Then
    
15.         n = d(zf)
    
16.         For j = 4 To 7
    
17.             If brr(i, j) <> "" And arr(n, j) = "" Then arr(n, j) = brr(i, j)
    
18.         Next
    
19.     End If
    
20. Next
    
21. For i = 2 To UBound(crr)
    
22.     zf = crr(i, 1) & "," & crr(i, 2)
    
23.     If d.exists(zf) Then
    
24.         n = d(zf)
    
25.         For j = 8 To 10
    
26.             If crr(i, j) <> "" And arr(n, j) = "" Then arr(n, j) = crr(i, j)
    
27.         Next
    
28.     End If
    
29. Next
    
30. Sheet4.Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
31. Sheet2.Rows(1).Copy Sheet4.[a1]
    
32. End Sub

复制代码

李子鑫

dsmch 发表于 2016-7-5 09:34

老师，如何将
Columns("D:G").Select    Selection.NumberFormatLocal = "h:mm"
添加进去呢，谢谢

dsmch

Sheet4.[d:g].NumberFormatLocal = "h:mm"
放在代码倒数第三行

李子鑫

dsmch 发表于 2016-7-5 14:55
Sheet4.[d:g].NumberFormatLocal = "h:mm"
放在代码倒数第三行

如果人员比较多的情况下，显示错误424，按F8测试到 arr = Sheet1.Range("a1:j" & Sheet1.Range("a65536").End(xlUp).Row)显示的，xlUp值为负数呢

李子鑫

dsmch 发表于 2016-7-5 09:34

请教一下老师，当我的打卡记录总行数为2805行的时候，提出近百人的数据后，总有几个人中的数据无法合并，把其它的人员删除后，又可以了，人员没有重复的问题！请问这是什么原因呢