­ã´£³¡ªL

³nµÛ³°---§Q¥ÎHÄæ±Æ§Ç:
¸ê®Æ±Æ§Ç¤ñ¸û¤ñ¹ï_V1.rar (20.89 KB)

¤U¸ü¦¸¼Æ: 9

2017-3-22 22:16

­ã´£³¡ªL

¦^´_ 6# oak0723-1

1. Sub TEST()
   
2. Dim i&, R&, C&, Arr, Brr, xD, V, U
   
3. Call Clear_All
   
4. Arr = Range("A8:D" & Cells(Rows.Count, 1).End(xlUp).Row)
   
5. Set xD = CreateObject("Scripting.Dictionary")
   
6. For i = 1 To UBound(Arr): xD(Arr(i, 2)) = "": Next i
   
7. U = xD.Count
   
8. For i = 1 To U
   
9. V = Application.Large(xD.keys, i)
   
10. xD(V) = i * 8 - 7: [i6].Cells(1, xD(V)) = V
    
11. Next i
    
12. 
    
13. R = Cells(Rows.Count, "H").End(xlUp).Row - 10
    
14. If R <= 0 Then Exit Sub
    
15. Brr = [H11].Resize(R)
    
16. For i = 1 To R: xD(Brr(i, 1)) = i: Next i
    
17. 
    
18. ReDim Brr(1 To R, 1 To U * 8)
    
19. 
    
20. For i = 1 To UBound(Arr)
    
21. R = xD(Arr(i, 1)): C = xD(Arr(i, 2)): If R = 0 Or C = 0 Then GoTo 101
    
22. 
    
23. V = Arr(i, 3)
    
24. If V >= [I9] And V < [K9] Then Brr(R, C + 0) = Brr(R, C + 0) + V: Brr(R, C + 1) = Brr(R, C + 1) + 1
    
25. If V >= [M9] And V < [O9] Then Brr(R, C + 4) = Brr(R, C + 4) + V: Brr(R, C + 5) = Brr(R, C + 5) + 1
    
26. 
    
27. V = Arr(i, 4)
    
28. If V >= [I9] And V < [K9] Then Brr(R, C + 2) = Brr(R, C + 2) + V: Brr(R, C + 3) = Brr(R, C + 3) + 1
    
29. If V >= [M9] And V < [O9] Then Brr(R, C + 6) = Brr(R, C + 6) + V: Brr(R, C + 7) = Brr(R, C + 7) + 1
    
30. 101: Next i
    
31. 
    
32. [i11].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
    
33. End Sub

½Æ»s¥N½X

060318-¬y¤ô±b&¤ÀÃþ±b_v1.rar (15.54 KB)

¤U¸ü¦¸¼Æ: 4

2017-3-25 10:51

­ã´£³¡ªL

¦^´_ 10# oak0723-1


For i = 1 To UBound(Arr): xD(Arr(i, 2)) = "": Next i

§ï¬°:
For i = 1 To UBound(Arr)
    If IsNumeric(Arr(i, 2) & "") Then xD(Arr(i, 2)) = ""
Next i