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

[µo°Ý] VBA­×§ï : ½Æ»s¦³¨ç¼Æªº¤u§@ªí¡A¨Ã¥t¦s¨ì·sªº¤u§@ï

[µo°Ý] VBA­×§ï : ½Æ»s¦³¨ç¼Æªº¤u§@ªí¡A¨Ã¥t¦s¨ì·sªº¤u§@ï

¤p§Ì¡A¦³¤@­ÓÀÉ®×¥s°µ "¶g¡B¤ë³øªí.xlsm"
¸Ì­±¦³¤u§@ªí¤À§O¬°¡G¶g³øªí¡B¤u§@¶i«× µ¥¨â­Ó¡C
¶g³øªí¸Ì­±¦³­Ó¨ç¼Æ¬° =sheetname ¡A³o¬O¬°¤F§Ú¤è«K®Ú¾Ú"¤u§@¶i«×"¨Ï¥ÎVLOOKUP §ì¥X¼Æ¾Ú¡C
©Ò¥H§Ú¥u­n½Æ»s¶g³øªí¡A¨Ã¥t¦W¬°"²Ä¤@¶g" ¥L´N·|¥h§ì"¤u§@¶i«×"¦X¥Gªº¤º®e
¦]¦¹¡A§Ú°Ñ·Óª©¤W¼g¤F¥H¤UVBA
  1. Sub test3()

  2.     Dim I As Long
  3.     Dim xWeek As Integer
  4.     Dim xS As Worksheet
  5.     Dim xPH$
  6.     xPH = ThisWorkbook.Path & "\"
  7.    
  8.     On Error Resume Next
  9.    
  10.     Application.ScreenUpdating = False
  11.    
  12.     Set xS = Sheets("¶g³øªí")
  13.         xWeek = InputBox("½Ð¿é¤J²Ä""?""¶g")
  14.             xS.Copy After:=Sheets(Sheets.Count)            
  15.             ActiveSheet.Name = "²Ä" & xWeek & "¶g"
  16.                 Set xName = ActiveSheet
  17.                     xName.Copy
  18.                     
  19.             Application.DisplayAlerts = False
  20.             
  21.                 With xName.UsedRange
  22.                     .Value = .Value
  23.                 End With                                                         

  24.                 With ActiveWorkbook
  25.                     ActiveSheet.Name = "²Ä" & xWeek & "¶g"
  26.                     .SaveAs xPH & "²Ä" & xWeek & "¶g.xlsx", CreateBackup:=False
  27.                     .Close
  28.                 End With
  29.                
  30.     Application.ScreenUpdating = True
  31.    
  32. End Sub
½Æ»s¥N½X
¥D­n¥Øªº´N¬O¥i¥HÅý§Ú¿é¤J²Ä"´X"¶g¡A´N·|²£¥Í¤@­Ó ²Ä"´X"¶g ¤u§@ªí¡A¨Ã¥ýÅý¥L¶]¤@¤U¨ç¼Æ«á( ¨Ò¡GVLOOKUP..µ¥)
µM«á¥H¯Â¶K¤W­Èªº¤è¦¡¨ú¥N
©Ò¥H¼g³o­Ó
  1.          
  2.                     With xName.UsedRange
  3.                     .Value = .Value
  4.                     End With   
½Æ»s¥N½X
¦ý¬O·Q§â¥L¥t¦s¨ì¥Ø«e¤u§@ï("¶g¡B¤ë³øªí.xlsm")ªº®ÇÃä(¦P¸ê®Æ§¨¤U)
©Ò¥H°Ñ¦Ò§O¤H¼g¤F
  1.                
  2.                    With ActiveWorkbook
  3.                     ActiveSheet.Name = "²Ä" & xWeek & "¶g"
  4.                     .SaveAs xPH & "²Ä" & xWeek & "¶g.xlsx", CreateBackup:=False
  5.                     .Close
  6.                   End With
½Æ»s¥N½X
¦ý¥t¦sªºÀɮפº®eÁÙ¬O°Ñ·Ó¨ì"¶g³øªí"¨ç¼Æ......¬Æ¦Ü±ø¥ó¤£¨¬³y¦¨¶Ã½X¡A
¤£ª¾¹D«ç»ò§â¥¦¼g¦¨¡A¥t¦s¤§«á¤]¬O¥H¯Â¶K¤W­Èªº¤è¦¡........
¦A½Ð¨D¦U¦ì¤j¯««üÂI°g¬z.....«ô°U¤F

§Ú¸É¥R»¡©ú¤@¤U
°²³]§Ú½Æ»s¦¨¥\«á,¥B¥t¦s·sªºÀÉ®×
¨º»ò­ì¥ýªºÀɮפ£¬O·|²£¥Í¤u§@ªí¶Ü
¥L¯à²¾°£¶Ü¡H
©ÎªÌ¬O¦³¤°»ò¤è¦¡
¥ý½Æ»s®Ú¾Ú¦WºÙ¶]¨ç¼Æ¡AµM«áª½±µ²£¥Í¨ì·sªºÀɮרåH¯Â­È¤è¦¡¶K¤W¡C
¤£·|¦Ó¥~¦bªºÀɮײ£¥Í·s¤u§@ªí
¤£ª¾¹D³o¼Ëªí¹F¦U¦ì¤j¯«¯à¤F¸Ñ¶Ü

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-24 00:50 ½s¿è

¦^´_ 1# edmondsforum

¨SÀÉ®×´ú¸Õ........¥u¯à¬Ý§Aªºµ{¦¡¦b¸£®ü¤¤ºt½m

¤£¹L½T¹êÅý§Ú¬Ý¨ì°ÝÃD¡A§A¤u§@ªícopyªº®É­Ô ÁÙ¬O¦³¤½¦¡ªº

©Ò¥H­n½Õ´«¶¶§Ç¡A¥ý¼g


With xName.UsedRange
     .Value = .Value
End With


¦A¼g

xName.Copy

¥h±¼¤½¦¡¦A½Æ»s¤u§@ªí°ò¥»¤W´N¨S°ÝÃD¤F


§Ú¸É¥R»¡©ú¤@¤U
°²³]§Ú½Æ»s¦¨¥\«á,¥B¥t¦s·sªºÀÉ®×
¨º»ò­ì¥ýªºÀɮפ£¬O·|²£¥Í¤u§@ªí¶Ü
¥L¯à²¾°£¶Ü¡H

¦b Application.ScreenUpdating = True ³o¦æµ{¦¡«e­± ¼g§R°£¤u§@ªí¡AÀ³¸Ó´N¥i¥H¤F

xName.delete

¦pªG°õ¦æ¦³¿ùªº¸Ü¡A½Ðªþ¤WÀɮרӬݬݧa¡A§Ú´X¥G¬Oª¼¼gªº
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-24 01:13 ½s¿è

¦^´_ 3# n7822123


ÁקK§A¬Ý¤£À´§Ú¦bÁ¿¤°»ò¡A²£¥ÍÂû¦PÀnÁ¿¡AÁÙ¬O§ïµ¹§A¡A§A´ú¸Õ¬Ý¬Ý

Sub test3()

    Dim I As Long
    Dim xWeek As Integer
    Dim xS As Worksheet
    Dim xPH$
    xPH = ThisWorkbook.Path & "\"
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xS = Sheets("¶g³øªí")
    xWeek = InputBox("½Ð¿é¤J²Ä""?""¶g")
    xS.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "²Ä" & xWeek & "¶g"
    Set xName = ActiveSheet
    With xName.UsedRange
        .Value = .Value
    End With
    xName.Copy
   With ActiveWorkbook
       ActiveSheet.Name = "²Ä" & xWeek & "¶g"
      .SaveAs xPH & "²Ä" & xWeek & "¶g.xlsx", CreateBackup:=False
      .Close
   End With
   xName.Delete
   Application.ScreenUpdating = True
   
End Sub
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¦^´_ 4# n7822123
©êºpªGµM¯uªº¨SÀÉ®×·|Åý¤H«ÜÃø²z¸Ñ@@
½Ð½Ì¸Ñ¡A§Ú¦A«×­z»¡¤@¦¸
1.°²³]§Ú°õ¦æVBA¤F¡A¿é¤J¶g¼Æ¤F
01.png
2020-6-24 08:25


2.¿é¤J3¤§«á¡A·|²£¥Í"²Ä3©P"¡A¦¹®É¦a³o­ÓÀɮתº²Ä3¶g
¨Æ¥ý®Ú¾Ú²Ä3¶g¥h¶]VLOOKUP«á¡A¥H¯Â­È¶K¤W¡C
02.png
2020-6-24 08:25


3.³oÃä§Ú´£­Ó°ÝÃD¡A¬°¤°»ò¶]§¹¤§«á¡A§Ú³oÃ䪺"¶g³øªí"ªº¤½¦¡ =SHEETNAME ³£¼È®É·|¥H²Ä3¶g§e²{?
¦ý¥u­nÂI¨â¤U´N·|¥¿±`¡A¦³¿ìªkÅý¥L¦Û°Ê§ó·s¶Ü?

4.±µµÛ2¡A¶]§¹¤§«á¡A¦P®ÉÀÉ®×®ÇÃä¤]·|²£¥Í"²Ä3¶g"ªºÀɮסA¦ý¬O¥¼¶}±Òªº(¤j¤j±Ð§Ú§ï¼gªº¤è¦¡·|¨Ï¥L¦P®É¶}±Ò)
¦]¬°±N¨Ó·|¦³§å¶q²£¥Íªº°ÝÃD
04.png
2020-6-24 08:25


5.µM«á§ÚÂI¶}²£¥Í¥t¤@­ÓÀɮתº"²Ä¤T¶g" ¤´µMÁÙ¬O¦³¤½¦¡¦s¦b
05.png
2020-6-24 08:26


6.¥H¤W´N¬O§Úªº°ÝÃD¡A¥Ø«eÀɮ׸̭±¦³¤T­Óµ{¦¡½X
06.png
2020-6-24 08:26

"¤u§@¶i«×"¥Ø«e¨Ï¥Îªº¬O Create1 Create3
¥Ø«e¬O¥Htest3¦A¶]¡A¦pªG¦¨¥\¡A·|¤À§OÀ³¥Î¦b Create1 Create3
¦pªG¥i¥H¦A½Ð¤j¤jÀ°¦£¤@°_§ï¼g.....¤@­Ó¿W¥ß½Æ»s  ¤@­Ó¬O§å¶q½Æ»sªº

ÀɮרѰѦÒ
TEST.zip (356.97 KB)
03.png

TOP

¦^´_ 5# edmondsforum

With xName.UsedRange
                    .Value = .Value
End With
§ï¬°
With ActiveSheet.UsedRange
        .Value = .Value
End With

¦]¬°xName³Q³]©w¬°­ìÀɮתºSheet¤F,©Ò¥H¬O±N­ìÀɮתº§ï¬°­È

TOP

¦^´_ 6# jcchiang
ÁÂÁ¤j¤j
§ï¦¨³o¼Ë¤§«á¡A«á­±¦b¥[¤@­Ó xName.Delete ½T¹ê¯à³Ð³y§Ú­nªº
ªþ¤W­×§ï«áªº
  1. Sub test3()

  2.     Dim I As Long
  3.     Dim xWeek As Integer
  4.     Dim xS As Worksheet
  5.     Dim xPH$
  6.     xPH = ThisWorkbook.Path & "\"
  7.    
  8.     On Error Resume Next
  9.    
  10.     Application.ScreenUpdating = False
  11.    
  12.     Set xS = Sheets("¶g³øªí")
  13.         xWeek = InputBox("½Ð¿é¤J²Ä""?""¶g")
  14.             xS.Copy After:=Sheets(Sheets.Count)
  15.             ActiveSheet.Name = "²Ä" & xWeek & "¶g"
  16.                 Set xName = ActiveSheet
  17.                     xName.Copy
  18.                     
  19.             Application.DisplayAlerts = False
  20.             
  21.                 With ActiveSheet.UsedRange
  22.                     .Value = .Value
  23.                 End With

  24.                 With ActiveWorkbook
  25.                     ActiveSheet.Name = "²Ä" & xWeek & "¶g"
  26.                     .SaveAs xPH & "²Ä" & xWeek & "¶g.xlsx", CreateBackup:=False
  27.                     .Close
  28.                 End With
  29.                
  30.     xName.Delete
  31.     Application.ScreenUpdating = True
  32.    
  33. End Sub
½Æ»s¥N½X
¦ý§Ú³oÃ䦳¤T­Ó°ÝÃD

1.¬°¤°»ò¥u­n§Ú°õ¦æVBA ·|²£¥Í³o­Ó #N/A ÁöµMÂI¶i¥h¨â¤U´N·|¥¿±`
¾á¤ß¬O¤£¬O­þ­Óµ{¦¡½X¼g¿ù?
01.png
2020-6-24 10:08


2.§ÚÀ³¥Î¬Û¦Pªº¤è¦¡ §â¥¦¼g¦b§å¶q¤W­±¡A¦ý...´N¥d¦í¤F §å¶q½Æ»s¬O¡GSub Create1() '§å¶q½Æ»s'
·|¦º·í «¢«¢

3.½Ð°Ý§Ú¥t¦sªºÀɮצWºÙ¡A¥i¤£¥i¥H®Ú¾Ú¥Lªº¤é´Á ¥Ø«eªº¶g¼Æ ©M¤é´Á©R¦W©O?
¨Ò¦p¡A²Ä¤T¶g  ¡A¤é´Á¬O ¡G¦Û¥Á°ê 109 ¦~ 3 ¤ë 5 ¤é ¦Ü¥Á°ê 109 ¦~ 3 ¤ë 11 ¤é (¥H¶g­p)
ÀɮצW´N·|Åã¥Ü¡G1090305~1090311(²Ä¤T¶g).xlsx  
³Æµù¡A¨º­Ó109¦~03¤ë05¤é¬O¦bF1  ¡A 109¦~03¤ë11¤é ¬O¦bH1
02.png
2020-6-24 10:16


TEST02.zip (326.4 KB)

TOP

¦^´_ 7# edmondsforum

¹ï¤£°_¡A¯à³Â·ÐÀ°§Ú¼g¨â­Ó°w¹ï§å¶q½Æ»sªº¶Ü?
¥i¥H¤À§O¼g¨â­Ó¤£¦Pª¬ªp¡A¥t¦sªºµ{¦¡½X¶Ü

°²³]§Ú¿é¤J5
1.    ²Ä1¶g.XLSX ²Ä2¶g.XLSX  ²Ä3¶g.XLSX  ²Ä4¶g.XLSX  ²Ä5¶g.XLSX  5­ÓÀÉ®×
2     ²Ä1~5¶g.XLSX (¸Ì­±¦³5­Ó¤u§@ªí®@)
¦A«ô°U¦U¦ì亣¤j¤F:$

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-24 12:04 ½s¿è

¦^´_ 5# edmondsforum


xName ¬O±q¶g³øªí½Æ»s¥X¨Óªº¤u§@ªí (Ex:²Ä¤T¶g)

¥ý§âxName ¥h¤½¦¡ ¦A½Æ»s¥X¬¡­¶Ã¯¡A´N¤£·|¦³¤½¦¡

³Ì«á¦A§âxName§R±¼¡A´N¬O§Ú3¼Ó»P4¼Ó ¸ò§AÁ¿ªº¼gªk

·Pı§A5¼Ó»P7¼Óªº¦^µª¡A³s¸Õ§Úªºµ{¦¡³£¨S¦³À|¸Õ¹L

¨º§ÚÁÙ¦³¥²­n¦A¦^µª¤U¥h¶Ü?
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ edmondsforum ©ó 2020-6-24 12:43 ½s¿è

¦^´_ 9# n7822123
¹ï¤£°_Às­ô¡A½Ð­ì½Ì§Úªº²¨©¿
¬O§Ú©ñ¿ù¦ì¸m...¾É­PÁÙ¬O¶]¥X¤½¦¡¡A¦ý½T¹ê§Aªº¤è¦¡¬O¦¨¥\ªº
  1. Sub Create3() '¿W¥ß½Æ»s'
  2.     Dim I As Long
  3.     Dim xWeek As Integer
  4.     Dim xS As Worksheet
  5.     Dim xPH$
  6.     xPH = ThisWorkbook.Path & "\"
  7.    
  8.     On Error Resume Next
  9.    
  10.     Application.ScreenUpdating = False
  11.     Application.DisplayAlerts = False
  12.    
  13.     Set xS = Sheets("¶g³øªí")
  14.         xWeek = InputBox("½Ð¿é¤J²Ä""?""¶g")
  15.             xS.Copy After:=Sheets(Sheets.Count)
  16.             ActiveSheet.Name = "²Ä" & xWeek & "¶g"
  17.                
  18.                 Set xName = ActiveSheet
  19.                     With ActiveSheet.UsedRange
  20.                         .Value = .Value
  21.                     End With
  22.                     
  23.                     xName.Copy
  24.          
  25.                         With ActiveWorkbook
  26.                         ActiveSheet.Name = "²Ä" & xWeek & "¶g"
  27.                         .SaveAs xPH & "²Ä" & xWeek & "¶g.xlsx", CreateBackup:=False
  28.                         .Close
  29.                         End With
  30.                
  31.                     xName.Delete
  32.                     
  33.     Application.ScreenUpdating = True
  34.    
  35. End Sub
½Æ»s¥N½X
¯à«ô°U¤j¤jÀ°§ÚÀ訅 §å¶qªº¶Ü «ô°U«ô°U
  1. Sub Create1() '§å¶q½Æ»s'
  2.     Dim I As Long
  3.     Dim xWeek As Integer
  4.     Dim xS As Worksheet
  5.     Dim xPH$
  6.     xPH = ThisWorkbook.Path & "\"
  7.    
  8.     On Error Resume Next
  9.    
  10.     Application.ScreenUpdating = False
  11.     Application.DisplayAlerts = False
  12.    
  13.     Set xS = Sheets("¶g³øªí")
  14.         xWeek = InputBox("½Ð¿é¤J²Ä1¶g¡ã²Ä""?""¶g")
  15.         For I = 1 To xWeek
  16.             xSt.Copy After:=Sheets(Sheets.Count)
  17.             ActiveSheet.Name = "²Ä" & I & "¶g"
  18.             
  19.                 Set xName = ActiveSheet
  20.                     With ActiveSheet.UsedRange
  21.                         .Value = .Value
  22.                     End With
  23.                     
  24.                     xName.Copy
  25.                                  
  26.                         With ActiveWorkbook
  27.                             ActiveSheet.Name = "²Ä" & xWeek & "¶g"
  28.                             .SaveAs xPH & "²Ä" & xWeek & "¶g.xlsx", CreateBackup:=False
  29.                             .Close
  30.                         End With
  31.         Next
  32.         
  33.         xName.Delete
  34.         
  35.     Application.ScreenUpdating = True
  36.    
  37. End Sub
½Æ»s¥N½X
¥t¥~½Ð±Ð¡A

1.¬O¤£¬O±o·s¼W¬Y­Óµ{¦¡½X¡A¤~¯àÅý­ì¥»ªº"¶g³øªí"¤£·|²£¥Í #N/A ©O

2.¥t¦sªºÀɮצWºÙ¡A¥i¤£¥i¥H®Ú¾Ú¥Lªº¤é´Á ¥Ø«eªº¶g¼Æ ©M¤é´Á©R¦W©O?
   ¨Ò¦p¡A²Ä¤T¶g  ¡A¤é´Á¬O ¡G¦Û¥Á°ê 109 ¦~ 3 ¤ë 5 ¤é ¦Ü¥Á°ê 109 ¦~ 3 ¤ë 11 ¤é (¥H¶g­p)
   ÀɮצW´N·|Åã¥Ü¡G1090305~1090311(²Ä¤T¶g).xlsx  
   ³Æµù¡A¨º­Ó109¦~03¤ë05¤é¬O¦bF1  ¡A 109¦~03¤ë11¤é ¬O¦bH1


3.°²¦pÀs¤j¦¨¥\¼g¥X¡A§å¶qªº¡A¯àÀ°§Ú¤À§O¼g¥X¥t¦sªº®É­Ô ¨âºØµ²ªG¶Ü?
   °²³]¿é¤J5
   Aµ²ªG¡G¤À§O²£¥Í5­ÓÀɮסC( ²Ä1¶g.XLSX ²Ä2¶g.XLSX  ²Ä3¶g.XLSX  ²Ä4¶g.XLSX  ²Ä5¶g.XLSX)
   Bµ²ªG¡G¤@­ÓÀɮסC(²Ä1~5¶g.XLSX) ¸ÌÀY¦³5­Ó¤u§@ªí

¦A«ô°UÀs¤j¤F¡A§Ú¤U¦¸µ´¹ï¤£·|¥Ø¤p¤F¡A¹ï¤£°_:Q

TEST03.zip (327.32 KB)

TOP

        ÀR«ä¦Û¦b : ¯àµ½¥Î®É¶¡ªº¤H¡A¥²¯à´x´¤¦Û¤v§V¤Oªº¤è¦V¡C
ªð¦^¦Cªí ¤W¤@¥DÃD