Hsieh

¦^´_ 1# cait

1. Sub nn()
   
2. Dim Ar(11), Rng As Range, cnt%, r&, A As Range, k%, t1&, s&
   
3. Sheet2.Cells = ""
   
4. With Sheet1
   
5. r = 2: k = 1: ay = Array("¯Z¦¸", "³sÄò¦¸¼Æ", "½s¸¹", "¤é´Á", "¯Z¦¸", "¨®¸¹", "®É¶¡", "®É¶¡Âà´«", "³t«×", "³sÄò®É¶¡", "³sÄò¶ZÂ÷")
   
6. Do Until r > Application.CountA(.Columns("A"))
   
7. cnt = 1: t1 = .Cells(r, 6): s = .Cells(r, 7): Ar(0) = .Cells(r, 3): Set Rng = .Cells(r, 1).Resize(, 7)
   
8. 
   
9. Do Until .Cells(r, 1) + 1 <> .Cells(r + 1, 1) Or .Cells(r, 3) <> .Cells(r + 1, 3)
   
10. r = r + 1
    
11. Set Rng = Union(Rng, .Cells(r, 1).Resize(, 7))
    
12. cnt = cnt + 1
    
13. Loop
    
14. If cnt > 1 Then
    
15. If Rng(1, 3) <> Sheet2.Cells(2, k) And Sheet2.[A1] <> "" Then k = k + 12
    
16. Ar(1) = cnt
    
17. Ar(9) = .Cells(r, 6) - t1
    
18. Ar(10) = Ar(9) * s
    
19. Sheet2.Cells(1, k).Resize(, 11) = ay
    
20. Set A = Sheet2.Cells(65536, k + 2).End(xlUp).Offset(1, 0)
    
21. Sheet2.Cells(A.Row, k).Resize(, 11) = Ar
    
22. Rng.Copy Sheet2.Cells(A.Row + 1, k + 2)
    
23. Erase Ar
    
24. End If
    
25. r = r + 1
    
26. Loop
    
27. End With
    
28. End Sub

½Æ»s¥N½X