[µo°Ý] ¦p¦ó¶i¦æsheet1ªí¤£³sÄò«þ¨©©M¦^¦s¸ê®Æ?

luke

¦U¦ì¤j¤j

¤p§Ì·Q§âsheet1ªíBÄ椤¨âµ§¸ê®ÆB1:B64©MB101:B164¤º®e

«þ¨©¦Üsheet2ªí¤º©Ò«ü©wªº¯S©wÀx¦s®æ§YC:RÄæ°µ¾ã²z,

µM«á±Nsheet2³o¨Ç¯S©wÀx¦s®æ¤º®e¦^¦s¦Üsheet1ªí­ì¨ÓªºÀx¦s®æ¦ì¸m.

½Ð°Ý¦p¦ó¶i¦æsheet1ªí¤£³sÄò«þ¨©©M¦^¦s¸ê®Æ?

·Ð½Ð¥ý¶i«ü¾É.

TEST11.rar (23.51 KB)

¤U¸ü¦¸¼Æ: 8

2012-4-19 21:19

register313

¦^´_ 1# luke

1. Sub Âà¤J()
   
2. Sheet2.Columns("C:R") = ""
   
3. For C = 1 To 4
   
4.   Sheet1.[B1:B16].Offset(16 * (C - 1), 0).Copy Sheet2.[C3].Offset(0, 5 * (C - 1))
   
5.   Sheet1.[B101:B116].Offset(16 * (C - 1), 0).Copy Sheet2.[C22].Offset(0, 5 * (C - 1))
   
6. Next C
   
7. Sheet2.[C11:C12,C26,C30:C31,C34].EntireRow.Insert
   
8. End Sub
   
9. Sub 刴X()
   
10. Dim AR()
    
11. I = 0
    
12. For X = 1 To 2
    
13.   If X = 1 Then
    
14.     Set Rng = Sheet2.[C3:C20]
    
15.     I = 0
    
16.   Else
    
17.     Set Rng = Sheet2.[C24:C43]
    
18.     I = 0
    
19.   End If
    
20.   For C = 1 To 4
    
21.     For Each A In Rng.Offset(0, 5 * (C - 1))
    
22.       If A.Value <> "" Then
    
23.         ReDim Preserve AR(I)
    
24.         AR(I) = A.Value
    
25.         I = I + 1
    
26.       End If
    
27.     Next
    
28.   Next C
    
29.   If X = 1 Then
    
30.     Sheet1.[B1].Resize(I, 1) = Application.Transpose(AR)
    
31.   Else
    
32.     Sheet1.[B101].Resize(I, 1) = Application.Transpose(AR)
    
33.   End If
    
34. Next X
    
35. End Sub

½Æ»s¥N½X

luke

¦^´_ 2# register313


ÁÂÁÂR¤j¦h¦¸¨ó§U

Âà¥X¸ê®ÆOK,
¦ýsheet2ªí C:RÄ榳¨ÇÀx¦s®æ¦³­­¨î¡A¦]¦¹Âà¤J®É¤£¯à²M°£¤º®e

¤p§Ì¿ý»s¤F¤A­Ó¥¨¶°Macro1

·Ð½Ð¥ý¶i ¤j¤j«ü¾É¬O§_¥i¥H²¤Æµ{¦¡¤º®e
TEST11A.rar (20.22 KB)

¤U¸ü¦¸¼Æ: 2

2012-4-20 15:37

register313

¦^´_ 3# luke
µ{¦¡«e¥b¬q¬°Àx¦s®æ½Æ»s(¦]Àx¦s®æ¦ì¸mÅܤƤӦh,¨ä¥LÀx¦s®æ¤S¤£¯à§ó°Ê,©Ò¥Hµ{¦¡¨S¤Ó¤j²¤Æ)
µ{¦¡«á¥b¬q¬°Àx¦s®æ®Ø½u¤§Ã¸¨î

1. Sub Âà¤J()
   
2. Sheets("sheet1").Range("B1:B8").Copy Sheets("sheet2").Range("C3:C10")
   
3. Sheets("sheet1").Range("B9:B16").Copy Sheets("sheet2").Range("C13:C20")
   
4. Sheets("sheet1").Range("B17:B24").Copy Sheets("sheet2").Range("H3:H10")
   
5. Sheets("sheet1").Range("B25:B32").Copy Sheets("sheet2").Range("H13:H20")
   
6. Sheets("sheet1").Range("B33:B40").Copy Sheets("sheet2").Range("M3:M10")
   
7. Sheets("sheet1").Range("B41:B48").Copy Sheets("sheet2").Range("M13:M20")
   
8. Sheets("sheet1").Range("B49:B56").Copy Sheets("sheet2").Range("R3:R10")
   
9. Sheets("sheet1").Range("B57:B64").Copy Sheets("sheet2").Range("R13:R20")
   
10. Sheets("sheet1").Range("B101:B104").Copy Sheets("sheet2").Range("C24:C27")
    
11. Sheets("sheet1").Range("B105:B108").Copy Sheets("sheet2").Range("C29:C32")
    
12. Sheets("sheet1").Range("B109:B112").Copy Sheets("sheet2").Range("C35:C38")
    
13. Sheets("sheet1").Range("B113:B116").Copy Sheets("sheet2").Range("C40:C43")
    
14. Sheets("sheet1").Range("B117:B120").Copy Sheets("sheet2").Range("H24:H27")
    
15. Sheets("sheet1").Range("B121:B124").Copy Sheets("sheet2").Range("H29:H32")
    
16. Sheets("sheet1").Range("B125:B128").Copy Sheets("sheet2").Range("H35:H38")
    
17. Sheets("sheet1").Range("B129:B132").Copy Sheets("sheet2").Range("H40:H43")
    
18. Sheets("sheet1").Range("B133:B136").Copy Sheets("sheet2").Range("M24:M27")
    
19. Sheets("sheet1").Range("B137:B140").Copy Sheets("sheet2").Range("M29:M32")
    
20. Sheets("sheet1").Range("B141:B144").Copy Sheets("sheet2").Range("M35:M38")
    
21. Sheets("sheet1").Range("B145:B148").Copy Sheets("sheet2").Range("M40:M43")
    
22. Sheets("sheet1").Range("B149:B152").Copy Sheets("sheet2").Range("R24:R27")
    
23. Sheets("sheet1").Range("B153:B156").Copy Sheets("sheet2").Range("R29:R32")
    
24. Sheets("sheet1").Range("B157:B160").Copy Sheets("sheet2").Range("R35:R38")
    
25. Sheets("sheet1").Range("B161:B164").Copy Sheets("sheet2").Range("R40:R43")
    
26. With Sheets("sheet2").Range("C1:R43").Borders
    
27.   .LineStyle = xlContinuous
    
28.   .Weight = xlThin
    
29.   .ColorIndex = 0
    
30. End With
    
31. End Sub

½Æ»s¥N½X

luke

¦^´_ 4# register313


    ÁÂÁÂR¤jÀ°¦£

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

luke

¦^´_ 6# Hsieh


    ÁÂÁÂH¤j

     ²Ä30¦C À³§ï¬°C.Copy Sheet1.Cells(r, 2)

     ¦¹¥~, sheet2ªíC1:R4, ­YÀx¦s®æ¦³®æ½u,
     Âà¥X¨ìsheet1ªíBÄæ®É, ¦p¦ó®ø°£®æ½u

      ·Ð½Ð¥ý¶i«ü¾É

register313

¦^´_ 7# luke


   Sheet1.Range("B:B").Borders.LineStyle = xlNone

luke

¦^´_ 6# Hsieh


    ¦^ÂÐH¤j

    °õ¦æ"Âà¤J"«á, sheet2ªíW3:W62¦h¥X¤F4­Ó¦pªþ¥ó¶À¦â°Ï¶ô

    ·Ð½Ð¥ý¶i «ü¾É­×§ïµ{¦¡
    TEST11B.rar (18.48 KB)

¤U¸ü¦¸¼Æ: 3

2012-5-3 22:13

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