GBKEE

¦^´_ 1# jovi0801
¸Õ¸Õ¬Ý

1. Sub Ex() 'DatePart("WW", .Rows(xi).Cells(1))  ¶Ç¦^²Ä´X¶g
   
2.     Dim Rng As Range, xi As Integer
   
3.     With Sheets("¤é»ù®æ").Range("A1").CurrentRegion.Rows
   
4.         Set Rng = .Rows(1)
   
5.         xi = 2
   
6.         Do
   
7.             If DatePart("WW", .Rows(xi).Cells(1)) <> DatePart("WW", .Rows(xi + 1).Cells(1)) Then Set Rng = Union(Rng, .Rows(xi))
   
8.             xi = xi + 1
   
9.            If xi = .Rows.Count Then Set Rng = Union(Rng, .Rows(xi))
   
10.         Loop While xi < .Rows.Count
    
11.     End With
    
12.     With Sheets("©P»ù®æ")
    
13.         .UsedRange.Clear
    
14.         Rng.Copy .[a1]
    
15.     End With
    
16. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 4# jovi0801

1. Sub Ex() 'DatePart("WW", .Rows(xi).Cells(1))  ¶Ç¦^²Ä´X¶g
   
2.     Dim AR, xi As Integer, xAr As Integer, Rng As Range
   
3.     With Sheets("¤é»ù®æ")
   
4.         AR = Application.Transpose(.Range("A1").CurrentRegion.Rows(1).Value)         '¨ú±oÄæ¦ì
   
5.         xAr = 2
   
6.         xi = 2
   
7.         ReDim Preserve AR(1 To 5, 1 To xAr)                             '·s¼W¤@ºûªÅ¥Õ°}¦C
   
8.         Set Rng = .Cells(xi, "A")                                       '¤@¶gÀç·~ªº²Ä¤@¤Ñ¤é´Á¦ì¸m
   
9.         Do While .Cells(xi, "A") <> ""
   
10.             If DatePart("WW", .Cells(xi, "A")) <> DatePart("WW", .Cells(xi + 1, "A")) Then
    
11.                 Set Rng = Range(Rng, .Cells(xi, "E"))                   '¤@¶gÀç·~ªº²Ä¤@¤Ñ¤é´Á¦ì¸m  ¨ì  ³Ì«á²Ä¤@¤Ñ¦¬½L»ù¦ì¸m
    
12.                 AR(1, xAr) = Rng.Cells(1)                               '¤é´Á  Rng.Cells(1) ¤é´Á: ¶g¤@  ©Î .Cells(xi, "A") ¤é´Á: ¶g¤­(³Ì«á¤@¤Ñ)
    
13.                 AR(2, xAr) = Rng.Cells(1, 2)                            '¶}½L»ù
    
14.                 AR(3, xAr) = Application.Max(Rng.Columns(3))            '³Ì°ª»ù
    
15.                 AR(4, xAr) = Application.Min(Rng.Columns(4))             '³Ì§C»ù
    
16.                 AR(5, xAr) = .Cells(xi, "E")                            '¦¬½L»ù
    
17.                 If .Cells(xi + 1, "A") <> "" Then
    
18.                     Set Rng = .Cells(xi + 1, "a")
    
19.                     xAr = xAr + 1
    
20.                     ReDim Preserve AR(1 To 5, 1 To xAr)
    
21.                 End If
    
22.             End If
    
23.             xi = xi + 1
    
24.         Loop
    
25.     End With
    
26.     With Sheets("©P»ù®æ")
    
27.         .UsedRange.Clear
    
28.         .[A1].Resize(xAr, 5) = Application.Transpose(AR)
    
29.     End With
    
30. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 9# c_c_lai
¥[¤W´Á¶¡³o¤£¿ù°Ú ,¦ý¥i¤£»Ý·s¼WÅܼƨÓÅã¥Ü.   
AR(6, xAr) = scope & "-" & .Cells(xi, "A")   ->      AR(6, xAr) = Rng.Cells(1) & "-" & .Cells(xi, "A")