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

[µo°Ý] ½Ð°Ý¦p¦ó§âµL¸ê®Æªº¦h¾l­¶­±³]©w¤@«ö¶s§R°£

¦^´_ 9# simplehope
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub ¶×¥X¦a½S¸ê®Æ¨ì·s¤u§@ªí()
  3.     Dim Sh(1 To 2), Rng(1 To 2) As Range, xCol As Integer, R As Integer
  4.     Application.ScreenUpdating = False
  5.     Set Sh(1) = Sheets("Mom (38P) (2)")    '**¨¾¤î¥X¿ù: «ü©w¤u§@ªí¦WºÙ***
  6.     'Set Sh(1) = ActiveSheet ''§ì¥Ø«e¤u§@ªí¦WºÙ
  7.     '¨¾§b1
  8.     For Each Sh(2) In Sheets
  9.         If InStr(Sh(2).Name, "¶×¥X") Then
  10.             Application.DisplayAlerts = False
  11.             Sh(2).Delete
  12.             Application.DisplayAlerts = True
  13.             Exit For
  14.         End If
  15.     Next
  16.     With Sheets.Add(, Sheets(Sheets.Count))
  17.         .Name = Sh(1).Name & "¶×¥X"
  18.         Set Sh(2) = ActiveSheet
  19.     End With
  20.     Sh(1).Select
  21.     Sh(1).Range("A1:AM15").Copy
  22.     MyCopy Sh(2).Range("A1")
  23.     With Sh(1)
  24.         xCol = .VPageBreaks(1).Location.Column - 1
  25.         For i = 0 To .HPageBreaks.Count
  26.             If i = 0 Then
  27.                 Set Rng(1) = .Range("A16")
  28.             Else
  29.                 Set Rng(1) = .HPageBreaks(i).Location.Range("A16")
  30.             End If
  31.             If Rng(1).Cells(1, 6) <> "" Then
  32.                 With Rng(1)
  33.                     R = .Cells(1, 6).End(xlDown).Row - .Row
  34.                     If R < 25 Then R = R + 1
  35.                     Rng(1).Resize(R, xCol).Copy
  36.                 End With
  37.                 With Sh(2).Range("A" & Rows.Count).End(xlUp)(2)      ' (2)= .Offset(1) = .Cells(2)
  38.                     If .Row < 16 Then        'A13:A15 ¬°¦X¨ÖÀx¦s®æ : .Offset(1)-> = A14
  39.                         Set Rng(2) = .Parent.Range("A16")
  40.                     Else
  41.                         Set Rng(2) = .Cells
  42.                     End If
  43.                 End With
  44.                 MyCopy Rng(2)
  45.             Else
  46.                 Exit For
  47.             End If
  48.         Next
  49.     End With
  50.     Application.ScreenUpdating = True
  51.     MsgBox ("¶×¥X§¹¦¨")
  52. End Sub
  53. Sub MyCopy(Rng As Range)   'µ{¦¡(¶Ç»¼°Ñ¼Æ)  : ¬Û¦Pªºµ{¦¡½X¥i¥Î
  54.     With Rng
  55.         .PasteSpecial Paste:=xlPasteValues              '­È
  56.         .PasteSpecial Paste:=xlPasteColumnWidths 'Äæ¼e
  57.         .PasteSpecial Paste:=xlPasteFormats            '®æ¦¡
  58.     End With
  59. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

  1. Sub ¶×¥X¦a½S¸ê®Æ¨ì·s¤u§@ªí()
  2. Dim vSht As Worksheet, R&, vR As Range, SHN$, xSht As Worksheet

  3. Set vSht = ActiveSheet: SHN = vSht.Name & "¶×¥X"
  4. On Error Resume Next: Set xSht = Sheets(SHN): On Error GoTo 0
  5. If xSht Is Nothing Then Set xSht = Sheets.Add(after:=Sheets(Sheets.Count))

  6. With xSht
  7.      .Name = SHN:  .Cells.Clear '­«©R¦W, ²M°£¤º®e
  8.      R = Val(vSht.[AT51]) * 52: If R = 0 Then Exit Sub '¨ú±o­¶¼Æ
  9.      vSht.Range("A1:AM" & R).Copy .[A1] '¶K¤W¸ê®Æ
  10.      .Range("A16:A" & R) = "=TEXT(COUNT(AK$16:AK16),""'000"")" '§Ç¸¹¤½¦¡
  11.      .Range("A1:AM" & R) = .Range("A1:AM" & R).Value '¥þ³¡¤º®e¶K¦¨­È
  12.      For Each vR In vSht.[A1:AM1]
  13.          .Range(vR.Address).ColumnWidth = vR.ColumnWidth 'Äæ¼e
  14.      Next
  15. End With

  16. On Error Resume Next
  17. With xSht.Range("AK16:AK" & R)
  18.      .SpecialCells(xlCellTypeConstants, 22).EntireRow.Delete '§R°£¡e¤å¦r¡f®æ¾ã¦C
  19.      .SpecialCells(xlCellTypeBlanks).EntireRow.Delete  '§R°£¡eªÅ¥Õ®æ¡f¾ã¦C
  20. End With
  21. On Error GoTo 0

  22. xSht.Select
  23. End Sub
½Æ»s¥N½X
¡@
Xl0000046.rar (144.56 KB)
¡@
¡@

TOP

[ª©¥DºÞ²z¯d¨¥]
  • GBKEE(2016/10/9 19:54): Dim Sh(1 To 2), Rng(1 To 2) As Range, xCol As Integer, R As Integer, i As Integer

¦^´_ 11# GBKEE

­º¥ý·PÁÂG¤jªá¨º»ò¦h®É¶¡¡AÁÙ³o»ò§Ö¦^À³¡A¶W·P°Êªº¡I
°õ¦æ«á·|¦³"Åܼƥ¼©w¸q"¿ù»~¡Aµ{¦¡Åã¥Ü¦b For i = 0 To .HPageBreaks.Count ¡A·í¤¤ªºi ¤Ï¥Õ

¤p§Ì¥Î¦Û¤w­ì¥»ªºVBA½X¡A¤g¬¶¸Ñ¨M°ÝÃD¦p¤U¡G
¦]¯à¤O¤£¨¬±q¿é¥X­¶(¨Ó·½­¶)§ï½Æ»s½d³ò¡A´N´«±q¿é¤J­¶(¶×¥X­¶) ¤U¤â
­ì¥»§PÂ_[A16]¦V¤U¨ì³Ì«á¤@¦C¦Aoffset¤@¦C, §ï¥Ñ±q[F16]¶}©l§PÂ_¡A¦V¤U¨ì³Ì«á¤@¦C¦Aoffset¨ìAÄæ¡A
¦]FÄæ¦b¿é¥X­¶­YªÅ¥Õ¡A­ì¥»´NµL¤½¦¡(µL¸ê®Æ)¡A©Ò¥H¨ì¤F¶×¥X­¶¤]¬OµL¸ê®Æ¡A¥Î¥H¤W¤èªk«K¥i¥H¦³½Æ»s¸ê®Æ³sÄò©Ê

«Ü¨ØªA«D¨Ï¥ÎªÌªºG¤j¡A¯à¼g¥X²Å¦X¹ê»Ú¥Î³~¤S¦p¦¹Â²¬ù¦³®Ä²vªºµ{¦¡½X¡I
¤p§Ì¥\¤O©|²L¼g¥Xªºµ{¦¡«Ü²ÊÁW¡A¹ïG¤jµ{¦¡½X¼È®É¥u¯à±æ¦Ó¿³¹Ä¡AºCºC¬ã¨s°Ú
  1. Sub ¶×¥X¦a½S¸ê®Æ¨ì·s¤u§@ªí()
  2.    
  3.     shn = ActiveSheet.Name
  4.         
  5.     '¨¾§b1
  6.     For e = 2 To Sheets.Count
  7.         If shn & "¶×¥X" = Sheets(e).Name Then
  8.             Application.DisplayAlerts = False
  9.             Sheets(shn & "¶×¥X").Delete
  10.             Application.DisplayAlerts = True
  11.         Exit For
  12.     End If
  13.     Next

  14.    
  15.     Application.ScreenUpdating = False
  16.    


  17.     Worksheets.Add after:=Worksheets(Sheets.Count)
  18.     Worksheets(Sheets.Count).Name = shn & "¶×¥X"

  19.     '§ì¨úÄæ¦ì ·s¼W
  20.     Worksheets(shn).Select
  21.     Range("A1:AM15").Select
  22.     Range("A1:AM15").Copy
  23.     Worksheets(Sheets.Count).Select
  24.     Range("A1").Select
  25.     Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
  26.     SkipBlanks:=False, Transpose:=False
  27.     ActiveSheet.Paste

  28.     '§ì¨ú¨C­¶¸ê®Æ¤º®e(¨Ï¥Î°j°é)
  29.     Worksheets(shn).Select
  30.     Dim i As Integer, j As Integer
  31.     j = Range("AT51").Value
  32.    
  33.     For i = 16 To 16 + j * 52 Step 52 'À³­nJ-1, ¦ý­Y¥u¦³¤@­¶·|¦³¿ù¡A¦h¶×¥X¤@­¶¨S®t
  34.         Worksheets(shn).Select
  35.         Range("a" & i & ":am" & i).Select
  36.         Range(Selection, Selection.End(xlToRight)).Select
  37.         Range(Selection, Selection.End(xlDown)).Select
  38.         Selection.Copy
  39.         Worksheets(Sheets.Count).Select

  40.     If Worksheets(Sheets.Count).Range("F16") = "" Then
  41.         Range("A16").Select
  42.         ActiveSheet.Paste '¥ý¶K¤@¦¸§t¤½¦¡
  43.         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
  44.         SkipBlanks:=False, Transpose:=False '¦A¶K¤@¦¸§â¤½¦¡®³±¼
  45.         Range("F16").End(xlDown).Offset(1, -5).Clear '§R°£AÄæ¸ê®Æ,¥H§Q¶K¤W¸ê®Æ³sÄò
  46.     Else
  47.         Worksheets(Sheets.Count).Range("F16").End(xlDown).Offset(1, -5).Select
  48.         ActiveSheet.Paste '¥ý¶K¤@¦¸§t¤½¦¡
  49.         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
  50.         xlNone, SkipBlanks:=False, Transpose:=False '¦A¶K¤@¦¸§â¤é´ÁÅܬ°¤å¦r
  51.       
  52.     End If
  53. Next

  54. end sub
½Æ»s¥N½X

TOP

¨Sª`·N­ìªí¤½¦¡°Ñ·Ó®æ¦b½Æ»s½d³ò¤§¥~¡A­×§ï¤@¤U¡G

With xSht
¡@¡@¡@.Name = SHN:  .Cells.Clear '­«©R¦W, ²M°£¤º®e
¡@¡@¡@.[BK3] = vSht.[BK3].Value
¡@¡@¡@.[AV1] = vSht.[AV1].Value

¡@¡@¡@.[BI3] = vSht.[BI3].Value
¡@¡@¡@R = Val(vSht.[AT51]) * 52: If R = 0 Then Exit Sub '¨ú±o­¶¼Æ
¡@¡@¡@vSht.Range("A1:AM" & R).Copy .[A1] '¶K¤W¸ê®Æ
¡@¡@¡@.Range("A16:A" & R) = "=TEXT(COUNT(AK$16:AK16),""'000"")" '§Ç¸¹¤½¦¡
¡@¡@¡@.Range("A1:AM" & R) = .Range("A1:AM" & R).Value '¥þ³¡¤º®e¶K¦¨­È
¡@¡@¡@For Each vR In vSht.[A1:AM1]
¡@¡@¡@¡@¡@.Range(vR.Address).ColumnWidth = vR.ColumnWidth 'Äæ¼e
¡@¡@¡@Next
¡@¡@¡@.[BK3] = "": .[AV1] = "": .[BI3] = ""
End With

TOP

¦^´_ 12# ­ã´£³¡ªL

·PÁ­ã¤jµo¥\±Ï¥@¡I
­ã¤jªº·§©À¬O¹ï¿é¥X­¶°µ­×§ï¡A«ÜÅå³Yµ{¦¡½X³º¯à³o¼Ë¼g¡I¤Ó¼F®`¡I´Nºâ§Ú·Q¯}ÀY¤]·Q¤£¥X¨Ó¡K
µ{¦¡½X§¹¥þ¨S°ÝÃD¡A±©¤@ªº°ÝÃD¬O¤p§Ì¬Ý¤£¤ÓÀ´¥H¤U¡G

.SpecialCells(xlCellTypeConstants, 22).EntireRow.Delete '§R°£¡e¤å¦r¡f®æ¾ã¦C
¬A¸¹¤º¬°¦ó­n¥[ ,22³o°Ñ¼Æ? F1¬d¸ß¨S¬Ý¨ì¦³»¡©ú22


µ{¦¡½X³Ì«á¥[ªºOn Error GoTo 0¡A¥Î·N¬°¦ó¡H
F1¬d¸ß: °±¤î²{¦bµ{§ÇùØ¥ô¦ó¤w±Ò°Êªº¿ù»~³B²zµ{¦¡¡C
·|«Øij¥ô¦óµ{¦¡½X¡A ³£¦bµ²§À¥[¤W"On Error GoTo 0" ¶Ü¡H

TOP

¦^´_ 14# ­ã´£³¡ªL

ºF·\¡K¤p§Ì¤]¨Sµoı¡K
·d¤£À´¡A¬°¦ó¨S­×¥¿¤§«e¡A¤@¼Ë¬Ocopy ,    vSht.Range("A1:AM" & R).Copy .[A1] '¶K¤W¸ê®Æ
·Ó²z¨Ó»¡À³¸Ó·|¤@¤­¤@¤Q§âRange("A1:AM" & R)ªº¤º®ecopy ¹L¥h¡A
¦ý´«¤F[AV1]¤U©Ô¿ï³æªº¶µ¥Ø¡A«oÁÙ¬Ocopy ¨S´«¤§«eªº¤º®e¡H
¤p§Ì¤£À´¡A¯à»¡©ú¤@¤U­ì¦]¶Ü¡H

With xSht
      .Name = SHN:  .Cells.Clear '­«©R¦W, ²M°£¤º®e
      .[BK3] = vSht.[BK3].Value
      .[AV1] = vSht.[AV1].Value
      .[BI3] = vSht.[BI3].Value
      R = Val(vSht.[AT51]) * 52: If R = 0 Then Exit Sub '¨ú±o­¶¼Æ
      vSht.Range("A1:AM" & R).Copy .[A1] '¶K¤W¸ê®Æ
      .Range("A16:A" & R) = "=TEXT(COUNT(AK$16:AK16),""'000"")" '§Ç¸¹¤½¦¡
      .Range("A1:AM" & R) = .Range("A1:AM" & R).Value '¥þ³¡¤º®e¶K¦¨­È
      For Each vR In vSht.[A1:AM1]
          .Range(vR.Address).ColumnWidth = vR.ColumnWidth 'Äæ¼e
      Next
      .[BK3] = "": .[AV1] = "": .[BI3] = ""
End With

TOP

¦^´_ 16# simplehope

¸ÕµÛ¤â°Êcopy ½d³ò¡A¦A¶K¨ì·s¤u§@ªí¡A
´Nµo²{¤º®e¤¤¦³¤½¦¡ªº®æ¤l³£¨S¸ê®Æ¡A¦]¬°¯Ê¥F°Ñ·Ó¡K
¦n¹³ª¾¹D¬°¤°»ò¤F¡K
¯àµo²{³o¤]¤Ó¯«

TOP

¦^´_ 17# simplehope

ºÃ°Ý¥Î¤p§Ì­ì¥»ªºµ{¦¡½X·|¤£·|¦³³o°ÝÃD¡A
¦^ÀY¬Ý¤~µo²{¡A­ì¨Ó¬O§Ú¶K¤W¨â¦¸¡K²Ä¤@¦¸ª½±µpaste, ²Ä¤G¦¸¶K¤W­È&®æ¦¡¡A©Ò¥H¤~¨S¥X²{¯Ê¥F°Ñ·Óªº°ÝÀY
¡K¯u¬O¤g¬¶+½M¿ß¸I¤W¦ºÏû¤l¡K

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2016-10-9 20:05 ½s¿è

¦^´_ 15# simplehope


.SpecialCells(xlCellTypeConstants, 22).EntireRow.Delete '§R°£¡e¤å¦r¡f®æ¾ã¦C
¥Îªº¬O¥\¯àªí¡G½s¿è¡Ö¨ì¡Ö¯S®í¡]¨ä¥¦ª©¥»¥i¯à¤£¦P¡A§ä¬Ý¬Ý¡^¡@¡@


¦]¬°AKÄ榳®Ä¤º®e¬°¡e¼Æ­È¡f¡A©Ò¥H¥u­n±N¡e¤å¦r¡f¤Î¡eªÅ®æ¡f¾ã¦C®³±¼¡A³Ñ¤Uªº´N¬O©Ò»Ý¡G¡@
¡@¡@

¨Ï¥Î¡e¿ý»s¡f´N¥i¥H¨ú±oµ{¦¡½X¡]­n¿ý¨â¦¸¡^¡I¡@
¡@
¨Ï¥Î³o¥\¯à®É¡A­Y¿ï¨ú½d³ò¤¤¨S¦³¤å¦r¤ÎªÅ®æ¡Aµ{¦¡·|µo¥Í¿ù»~¦Ó¤¤Â_¡A
©Ò¥H«e­±¥[­Ó¡@On Error Resume Next ¡]²¤¹Lµ{¦¡¿ù»~Ä~Äò°õ¦æ¡^¡A
³o¬O¤w¹wª¾¤U¨â¦æµ{¦¡¥i¯à¦³¿ù»~µo¥Í«e´£¤U©Ò¥[ªº¡A
·í¨º¨â¦æµ{¦¡°õ¦æ§¹²¦¡A¥²¶·Åýµ{¦¡«ì´_¡e°»¿ù¡fªº¥\¯à¡A
©Ò¥H¦A¥[¡@On Error GoTo 0¡@¡]«ì´_°»¿ù¡^¡A
§_«h«á­±ªºµ{¦¡­Y¦³¿ù»~±NµL±q±oª¾¡A¤]¦]¦¹¥i¯à³B²z¥X¨Óªº¸ê®Æ¨Ã¤£¥¿½T¡A¦ÓµL¿ù»~´£¥Ü¡A
¤W¤@¬qªº¡G
On Error Resume Next
Set xSht = Sheets(SHN)¡@¡Ö¡@­Y¤u§@ªí¤£¦s¦b¡A¹w³]±N´£¥Ü¿ù»~¡A¦¹®É´£¥Ü´N²¤¹L¤F
On Error GoTo 0
¡@
¡@

TOP

¦^´_ 16# simplehope


¤½¦¡°Ñ·Ó¨Ã¥¼±a¤u§@ªí¦WºÙ¤Þ¼Æ¡A
¦]¦¹¶K¦Ü¨ä¥¦ªí®É¡A¥¦°Ñ·Óªº¬O¥»¨­ªíªºÀx¦s®æ¡A
¦ý³oªíªº°Ñ·Ó®æ¬OªÅ¥Õªº¡A¤½¦¡­È·íµM¬O¿ù»~ªº¡I

TOP

        ÀR«ä¦Û¦b : ¨Ã«D¦³¿ú¾{¬O§Ö¼Ö¡A°Ý¤ßµL·\¤ß³Ì¦w¡C
ªð¦^¦Cªí ¤W¤@¥DÃD