Hsieh

¦^´_ 5# luke
¸Õ¸Õ¬Ý

1. Sub Âà¤J()
   
2. With Sheet1
   
3.   r = 1: i = 3: k = 3
   
4.   Do Until r > 163
   
5.   .Cells(r, 2).Resize(IIf(r >= 65, 4, 8), 1).Copy Sheet2.Cells(i, k)
   
6.   If r = 65 Then
   
7.   r = 101
   
8.   Else
   
9.   r = r + IIf(r >= 65, 4, 8)
   
10.   End If
    
11.   If r <= 65 Then
    
12.      i = IIf(i = 3, 13, 3): k = IIf(i = 3, k + 5, k)
    
13.      ElseIf Int(((Int((r - 1) / 4) - 24) - 1) / 2) Mod 2 = 0 Then
    
14.      i = IIf(r = 101, 24, IIf(i = 24, 29, 24)): k = IIf(r = 101, 3, IIf(i = 24, k + 5, k))
    
15.      Else
    
16.      i = IIf(i = 29, 35, IIf(i = 35, 40, 35)): k = IIf(i = 24, k + 5, k)
    
17.   End If
    
18.   Loop
    
19. End With
    
20. End Sub
    
21. Sub 刴X()
    
22. Dim A As Range, C As Range
    
23. With Sheet2
    
24. Set A = Union(.[C3:R20], .[C24:R43])
    
25. For i = 1 To A.Areas.Count
    
26. r = IIf(i = 1, 1, 101)
    
27.    For j = 1 To 16 Step 5
    
28.    Set C = A.Areas(i).Columns(j).SpecialCells(xlCellTypeConstants)
    
29.    'C.Select
    
30.    C.Copy Sheet1.Cells(r, 3)
    
31.    r = r + C.Count
    
32.    Next
    
33. Next  
    
34. End With
    
35. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 9# luke

1. Sub Âà¤J()
   
2. Dim Rng As Range
   
3. With Sheet1
   
4. j = 3
   
5. For i = 1 To 57 Step 8
   
6. k = k + 1
   
7. r = IIf(k Mod 2 = 1, 3, 13)
   
8. Set Rng = .Cells(i, 2).Resize(8, 1)
   
9. Rng.Copy Sheet2.Cells(r, j)
   
10. j = IIf(r = 13, j + 5, j)
    
11. Next
    
12. j = 3
    
13. For i = 101 To 161 Step 4
    
14. k = k + 1
    
15. x = k Mod 4
    
16. r = IIf(x = 1, 24, IIf(x = 2, 29, IIf(x = 3, 35, 40)))
    
17. Set Rng = .Cells(i, 2).Resize(4, 1)
    
18. Rng.Copy Sheet2.Cells(r, j)
    
19. j = IIf(r = 40, j + 5, j)
    
20. Next
    
21. End With
    
22. End Sub

½Æ»s¥N½X