数据排列优化

hyonv

请帮帮忙...................数据肯定还会增大,人员也可能会增加.

dsmch

1. Dim arr, brr, d As Object, i&, j&, x, x1, x2
   
2. Set d = CreateObject("scripting.dictionary")
   
3. arr = Sheets(1).Range("a1").CurrentRegion
   
4. For i = 2 To UBound(arr)
   
5.     x = Split(arr(i, 2), " ")
   
6.     If Not d.exists(arr(i, 1) & "," & x(0)) Then d.Add arr(i, 1) & "," & x(0), x(1) Else d(arr(i, 1) & "," & x(0)) = d(arr(i, 1) & "," & x(0)) & "," & x(1)
   
7. Next
   
8. ReDim brr(1 To d.Count, 1 To 10)
   
9. a = d.keys: b = d.items
   
10. For i = 0 To d.Count - 1
    
11.     x1 = Split(a(i), ",")
    
12.     brr(i + 1, 1) = x1(0)
    
13.     brr(i + 1, 2) = x1(1)
    
14.     x2 = Split(b(i), ",")
    
15.     For j = 0 To UBound(x2)
    
16.         brr(i + 1, j + 3) = x2(j)
    
17.     Next
    
18. Next
    
19. Sheets(2).Activate
    
20. Cells.ClearContents
    
21. Range("a1:h1") = Array("姓名", "日期", "考勤1", "考勤2", "考勤3", "考勤4", "考勤5", "考勤6")
    
22. Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    

复制代码

修改这一句就行了：ReDim brr(1 To d.Count, 1 To 10)