ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ½Ð°Ý¤é»ù®æ«ç»òÂàÅܦ¨¶g»ù®æ©O?

¦^´_ 5# GBKEE
¦^´_ 8# jovi0801
§Ú¥[¤W¤F¤@Äæ "´Á¶¡" (scope) ¦p¦¹¥i¥H²M·¡¦a¬Ý¥X¥¦­ÌªºÂkÄÝ¡C
¯Â°Ñ¦Ò¡A§Æ±æ GBKEE ¤j¤j²ö¤¶·N¡C
  1. Sub Ex()                           ' DatePart("WW", .Rows(xi).Cells(1))  ¶Ç¦^²Ä´X¶g
  2.     Dim AR, xi As Integer, xAr As Integer, Rng As Range, scope As String
  3.    
  4.     With Sheets("¤é»ù®æ")
  5.         AR = Application.Transpose(.Range("A1").CurrentRegion.Rows(1).Value)     ' ¨ú±oÄæ¦ì
  6.         xAr = 2
  7.         xi = 2
  8.         ReDim Preserve AR(1 To 6, 1 To xAr)                      ' ·s¼W¤@ºûªÅ¥Õ°}¦C
  9.         
  10.         Set Rng = .Cells(xi, "A")                                ' ¤@¶gÀç·~ªº²Ä¤@¤Ñ¤é´Á¦ì¸m
  11.         scope = .Cells(xi, "A")
  12.         
  13.         Do While .Cells(xi, "A") <> ""
  14.             If DatePart("WW", .Cells(xi, "A")) <> DatePart("WW", .Cells(xi + 1, "A")) Then
  15.                 Set Rng = Range(Rng, .Cells(xi, "E"))            ' ¤@¶gÀç·~ªº²Ä¤@¤Ñ¤é´Á¦ì¸m  ¨ì  ³Ì«á²Ä¤@¤Ñ¦¬½L»ù¦ì¸m
  16.                 AR(1, xAr) = Rng.Cells(1)           ' ¤é´Á  Rng.Cells(1) ¤é´Á: ¶g¤@  ©Î .Cells(xi, "A") ¤é´Á: ¶g¤­(³Ì«á¤@¤Ñ)
  17.                 AR(2, xAr) = Rng.Cells(1, 2)                     ' ¶}½L»ù
  18.                 AR(3, xAr) = Application.Max(Rng.Columns(3))     ' ³Ì°ª»ù
  19.                 AR(4, xAr) = Application.Min(Rng.Columns(4))     ' ³Ì§C»ù
  20.                 AR(5, xAr) = .Cells(xi, "E")                     ' ¦¬½L»ù
  21.                 AR(6, xAr) = scope & "-" & .Cells(xi, "A")
  22.                
  23.                 If .Cells(xi + 1, "A") <> "" Then
  24.                     Set Rng = .Cells(xi + 1, "A")
  25.                     xAr = xAr + 1
  26.                     scope = .Cells(xi + 1, "A")
  27.                     ReDim Preserve AR(1 To 6, 1 To xAr)
  28.                 End If
  29.             End If
  30.             xi = xi + 1
  31.         Loop
  32.     End With
  33.    
  34.     With Sheets("©P»ù®æ")
  35.         .UsedRange.Clear
  36.         .[A1].Resize(xAr, 6) = Application.Transpose(AR)
  37.     End With
  38. End Sub
½Æ»s¥N½X
¤é»ù®æ«ç»òÂàÅܦ¨¶g»ù®æ.rar (9.85 KB)

TOP

¦^´_ 10# GBKEE
ÁÂÁ«ü¾É¡I
¥Ø«e§Ú¹ï©ó Set Rng ªºÀ³¥Î©|¥¼¤Q¤À±E±x¡A¥i¯à¬O¥H©¹¨S±µÄ²¹LExcel
ªº½t¬G¡C §Ú·|¦A¥[±j³o¤è­±ªºÀ³¥Î¡A ÁÂÁ±z¡I

TOP

        ÀR«ä¦Û¦b : Ä@­n¤j¡B§Ó­n°í¡B®ð­n¬X¡B¤ß­n²Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD