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

[µo°Ý] ¦A¦¸½Ð¯q¦¬¶O³æªº©µ¦ù°ÝÃD

[µo°Ý] ¦A¦¸½Ð¯q¦¬¶O³æªº©µ¦ù°ÝÃD

¦¬¶O³æ°£¤F®M¥Î[¼ÒªO®Mªí],¦ý¦],(®ÑÂǶO)¸ò(»²¾É¶O)¨C­Ó³£¤£¤@¼Ë,¦p¦ó¥Î[¾Ç¥Í¦W¥U]ªºD,EÄæ.®M¤J[¼ÒªO®Mªí]¤¤,·P®¦.

¦¬¶O³æ_20240315.rar (86.36 KB)

§ù¤p¥­

¥»©«³Ì«á¥Ñ hcm19522 ©ó 2024-3-17 13:37 ½s¿è

G7 (½Æ»s¨ì¦U³B)=VLOOKUP($P3,¾Ç¥Í¦W¥U!$C:$E,2+(COLUMN(A1)>1),)

(·j´M¿é¤J½s¸¹12534) googleºô§}:https://hcm19522.blogspot.com/
google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¦^´_ 1# dou10801

ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, i&, xR As Range, Z, T$, j%, Find As Range
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([¾Ç¥Í¦W¥U!F1], [¾Ç¥Í¦W¥U!A65536].End(3))
For j = 4 To 6
   T = Trim(Brr(1, j))
   If T = "" Then GoTo j01
   Set Find = [¼Òª©®Mªí!B5:X7].Find(T, Lookat:=xlWhole)
   If Find Is Nothing Then MsgBox "§ä¤£¨ì " & T & " ¶µ¥Ø": Exit Sub
   Z(Find.Value) = j: Set Z(Find & "/ad") = Find(, 6).Resize(, 2)
j01: Next
With Sheets("µ²ªG")
   .Activate: .UsedRange.EntireRow.Delete: Set xR = .[A1]
   For i = 2 To UBound(Brr)
      [¼Òª©®Mªí!D3] = Brr(i, 1): [¼Òª©®Mªí!K3] = Brr(i, 2): [¼Òª©®Mªí!P3] = Brr(i, 3)
      For j = 1 To Z.Count - 1 Step 2: Z.Items()(j).Value = Brr(i, Z.Items()(j - 1)): Next
      [¼Òª©®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"
   MsgBox "°õ¦æ§¹¦¨"
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 3# Andy2483
¥i§_¥[µù¸Ñ,Åý±ß½ú¾Ç²ß,·P¿E¤£ºÉ,ÁÂÁÂ.
§ù¤p¥­

TOP

¦^´_ 4# dou10801

ÁÂÁ½׾Â,ÁÂÁ«e½ú¤@°_¾Ç²ß
«á¾ÇÂǦ¹©«½Æ²ß­×­q,¤è®×¤ß±o¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, i&, xR As Range, Z, T$, j%, Find As Range
'¡ô«Å§iÅܼÆ:&¬Oªø¾ã¼Æ,$¬O¦r¦êÅܼÆ,%¬Oµu¾ã¼Æ,¨S¦³«ü©wªº¬O³q¥Î«¬ÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
Brr = Range([¾Ç¥Í¦W¥U!F1], [¾Ç¥Í¦W¥U!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¥H¤u§@ªíÀx¦s®æ­È±a¤Jªº¤Gºû°}¦C
For j = 4 To 6
'¡ô³]¶¶°j°éj±q4 ¨ì6
   T = Trim(Brr(1, j))
   '¡ô¥OTÅܼƬO1¦Cj°j°éÄæBrr°}¦C­È
   If T = "" Then GoTo j01
   '¡ô¦pªGTÅܼƬOªÅ¦r¤¸´N¸õ¨ì¼Ð¥Ü j01¦ì¸mÄ~Äò°õ¦æ
   Set Find = [¼Òª©®Mªí!B5:X7].Find(T, Lookat:=xlWhole)
   '¡ô¥O¥HTÅܼƷj´M½d³òÀx¦s®æ­È¥þ¦PªºÀx¦s®æ
   If Find Is Nothing Then MsgBox "§ä¤£¨ì " & T & " ¶µ¥Ø": Exit Sub
   '¡ô¦pªG§ä¤£¨ì!´N¸õ¥X´£¥Ü,µ²§ôµ{¦¡°õ¦æ
   Z(T) = j: Set Z(Find & "/ad") = Find(, 6).Resize(, 2)
   '¡ô¥OZ¦r¨å°O¿ý"¾Ç¥Í¦W¥U"ªíÄ渹,¥O¥HZ¦r¨å°O¿ý"¼Òª©®Mªí"ªíÀx¦s®æ
j01: Next
With Sheets("µ²ªG")
   .Activate: .UsedRange.EntireRow.Delete: Set xR = .[A1]
   '¡ô¥O¿E¬¡µ²ªGªí,¥O¸ê®Æ¾ã¦C§R°£,¥OxRÅܼƬO(ª«¥ó)Àx¦s®æ[A1]
   For i = 2 To UBound(Brr)
   '¡ô³]¶¶°j°é±q2¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
      [¼Òª©®Mªí!D3] = Brr(i, 1): [¼Òª©®Mªí!K3] = Brr(i, 2): [¼Òª©®Mªí!P3] = Brr(i, 3)
      '¡ô¥O°j°é¦C¯Z¯Å/®y¸¹/©m¦W ¦UÄæ±a¤Jµ²ªGªí
      For j = 1 To Z.Count - 1 Step 2: Z.Items()(j).Value = Brr(i, Z.Items()(j - 1)): Next
      '¡ô³]¶¶°j°é±N ®ÑÄy¶O/»²¾É¶O/¨ä¥L ¦UÄæ±a¤Jµ²ªGªí
      [¼Òª©®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)
      '¡ô¥O½Æ»s "¼Òª©®Mªí"ªí¸ê®Æ¦C¨ìµ²ªGªí«ü©wÀx¦s®æ
      xR.PageBreak = xlPageBreakManual
      '¡ô¥O³]©w ¤â°Ê¤À­¶
   Next
   .UsedRange.Interior.ColorIndex = xlNone
   '¡ô¥Oµ²ªGªíÀx¦s®æ©³¦â¬°µL¦â
   .Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28))
   '¡ô¥O²K¥[ ¦WºÙ,³]©wÀx¦s®æ½d³ò
   .PageSetup.PrintArea = "PrintArea"
   '¡ô³]©w¦C¦L½d³ò
   MsgBox "°õ¦æ§¹¦¨"
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 3# Andy2483

  .Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28))
>>> Range(.[A1], xR(0, 28)).name = "'" & .Name & "'!Print_Area" .... ª½±µ©w¸q¦WºÙ¬°¡e¦C¦L½d³ò¡f¡A¥B©w¸q¦WºÙ³Ì¦n«a¤W¤u§@ªí¦WºÙ
>>> .PageSetup.PrintArea = "PrintArea"  .... ¦³¤F¤W¤@¦æ, ³o¦æ¥i¬Ù²¤, PageSetup·|©ìºC³t«×, «D¥²­n¤Ö¥Î

TOP

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


    ÁÂÁ«e½ú«ü¾É
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

½Ð±Ð¨â¦ì¥ý¶i:
[­ì¨Ó]:.Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28))
[­ã¤j]:.Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28)).Name = "'" & .Name & "'!Print_Area"
°õ¦æ«á¥X²{:À³¥Îµ{¦¡©Îª«¥ó©w¸q¿ù»~.
·PÁÂÁ«ü¾É.
§ù¤p¥­

TOP

¦^´_ 8# dou10801

ÁÂÁ«e½ú¦^´_
«á¾Ç±N­ì¤è®×­×¦¨ ­ã¤j¤è®×«á °õ¦æ¨S¦³°ÝÃD
¦pªG«e½ú¦³¥Î Application.ScreenUpdating = False,§â¥¦§R±¼,¦A´ú¸Õ¬Ý¬Ý
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 9# Andy2483
¾Ç²ß¤¤,¨ºÃä¿ù¤F,½Ð«ü¥¿,·P®¦.

¦¬¶O³æ_20240325.rar (79.05 KB)

§ù¤p¥­

TOP

        ÀR«ä¦Û¦b : «Ý¤H°h¤@¨B¡A·R¤H¼e¤@¤o¡A´N·|¬¡±o«Ü§Ö¼Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD