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

[µo°Ý] »s§@¤TÁp¦¡¦¬¶O³æ½Ð¯q

[µo°Ý] »s§@¤TÁp¦¡¦¬¶O³æ½Ð¯q

¦p¦ó¥Î©T©w®Mªí¼Ò²Õ,²£¥Í¤TÁp¦¡,¦¬¶O³æ,·P®¦.

¦¬¶O³æ.rar (15.34 KB)

§ù¤p¥­

¦^´_ 1# dou10801


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ßVBA±±¨î¤À­¶¦C¦L,¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
¦¬¶O³æ_20240308.zip (251.42 KB)

Option Explicit
Sub TEST()
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Dim Brr, i&, xR As Range
Brr = Range([¾Ç¥Í¦W¥U!C2], [¾Ç¥Í¦W¥U!A65536].End(3))
With Sheets("µ²ªG")
   .UsedRange.EntireRow.Delete: Set xR = .[A1]
   For i = 1 To UBound(Brr)
      [¼Òª©®Mªí!D3] = Brr(i, 1): [¼Òª©®Mªí!K3] = Brr(i, 2): [¼Òª©®Mªí!P3] = Brr(i, 3)
      [¼Òª©®Mªí!1:15].Copy xR: Set xR = xR(16)
      [¼Òª©®Mªí!1:15].Copy xR: xR(5, 28) = "²Ä¤GÁp¦Û¯d": Set xR = xR(16)
      [¼Òª©®Mªí!1:14].Copy xR: xR(5, 28) = "²Ä¤TÁp¦¬¾Ú": Set xR = xR(15)
      xR.PageBreak = xlPageBreakManual
   Next
   .UsedRange.Interior.ColorIndex = xlNone
   .Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28)): .PageSetup.PrintArea = "PrintArea"
   .Activate: MsgBox "°õ¦æ§¹¦¨"
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 2# Andy2483
Andy2483«e½ú«ü¾É,¤j¤è¦V¤v§¹¦¨,¤p²Ó¸`¦Û¦æ¾Ç²ß§¹¦¨·P®¦.
§ù¤p¥­

TOP

        ÀR«ä¦Û¦b : ¦³¦h¤Ö¤O¶q´N°µ¦h¤Ö¨Æ¡A¤£­n¤ß¦sµ¥«Ý¡Aµ¥«Ý¤~·|¸¨ªÅ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD