ªð¦^¦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

¦^´_ 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

¦^´_ 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

¥»©«³Ì«á¥Ñ 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

¦^´_ 11# jcchiang
°Ú ÁÂÁ¤j¤jªº´£¿ô
­«·s§ï¦¨
  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 = "²Ä" & I & "¶g"
  28.                             .SaveAs xPH & "²Ä" & I & "¶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
ÁöµM¨S¥d¦í¡A¦ý¬O°²³]§Ú¿é¤J 3  ²£¥Í¡A ²Ä1¶g.xlsx   ²Ä2¶g.xlsx   ²Ä3¶g.xlsx
²Ä1¶g¤º®e¬OOKªº¡A¦ý¨ä¾lªº¥þ³¡³£¬O¸ò²Ä1¶g¤@¼Ëªº¤º®e...
¦Ó¥B¥L¤Ï¦Ó§â§Úªº "¶g³øªí" ¤u§@ªí ²¾°£±¼¤F...¨D¸Ñ

TOP

¥»©«³Ì«á¥Ñ edmondsforum ©ó 2020-6-30 01:08 ½s¿è

¦^´_ 13# n7822123

¸U¯ëªº·PÁÂÀs¤jªº¦^ÂÐ!!!!!

§Ú®Ú¾ÚÀs¤j´£¨Ñªºµ{¦¡½X¡A¨Ã¨Ì·Ó§A·N«ä§R°£§Ú¤£»Ý­nªº³¡¤À

Sub test0624()

Dim xWeek As Integer
Dim xS As Worksheet
Dim xPH$


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual          '°±¥Î¦Û°Ê­«ºâ
  

xPH = ThisWorkbook.Path & "\"
On Error Resume Next
Set xS = Sheets("¶g³øªí")
xWeek = InputBox("½Ð¿é¤J²Ä""?""¶g")
xlsName = xPH & "²Ä1~" & xWeek & "¶g.xlsx"
      
   
'Bµ²ªG¡G¤@­ÓÀɮסC(²Ä1~5¶g.XLSX) ¸ÌÀY¦³5­Ó¤u§@ªí
With Workbooks.Add
  sh_Cnt = .Sheets.Count
  For sh = 1 To xWeek
    xS.Activate
    xS.Copy After:=Sheets(Sheets.Count)
    Set xName = ActiveSheet
    ActiveSheet.Name = "²Ä" & sh & "¶g"
    With xName.UsedRange
        .Calculate
        .Value = .Value
    End With
    xName.Copy After:=.Sheets(.Sheets.Count)   'ª`Sheets«e­±¦³ "." ¬O½Æ»s¨ì·sªº¬¡­¶Ã¯
    xName.Delete
  Next sh
  
  '§R°£­ì¥»ªÅ¥Õªí®æ
  For sh = 1 To sh_Cnt: .Sheets(1).Delete: Next
  '¦sÀÉÃö³¬
  .SaveAs xlsName
  .Close True
End With
            
'Aµ²ªG¡G¤À§O²£¥Í5­ÓÀɮסC( ²Ä1¶g.XLSX ²Ä2¶g.XLSX  ²Ä3¶g.XLSX  ²Ä4¶g.XLSX  ²Ä5¶g.XLSX)
'³o¬q°ò¥»¤W¥i¤w»P¤W­±¨º¬q¦X¨Ö¼g¡A¦ýµ{¦¡·|¤£¦n¾\Ū¡A¬°¤FÅý§A¬ÝÀ´¡A¥ý©î¶}¼gµ¹§A
'¦]¬°§Úªº¶g³øªíF1 »P G1 ³£¬O¿ù»~­È¡AÀɦWªº¤é´Á§Ú¥ý¦Û¤v©w¸q¡A§A¦A¦Û¤v­×§ï!
With Workbooks.Open(xlsName)
  For sh = 1 To .Sheets.Count

    Strday = .Sheets(sh).[F1]                                                '§Aªº¤é´Á¶}©l¡A½Ð¦Û¦æ¥´¶}´ú¸Õ
    Endday = .Sheets(sh).[H1]                                             '§Aªº¤é´Áµ²§ô¡A½Ð¦Û¦æ¥´¶}´ú¸Õ
    xlsName = "(" & .Sheets(sh).Name & ").xlsx"
    xlsName = xPH & Strday & "~" & Endday & xlsName
    .Sheets(sh).Copy
    ActiveWorkbook.SaveAs xlsName
    ActiveWorkbook.Close True
  Next
  .Close False
End With

Set xS = Nothing
Set xName = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic     '±Ò¥Î¦Û°Ê­«ºâ
   
End Sub

§Úµo²{¦pªG§Ú­ì¥»ªº³o­Ó   xS = Sheets("¶g³øªí")   ¸Ì­±ªºF1 ¸ò H1 ¬O¯Â¤å¦rªº¸Ü¡A
´N·|¦¨¥\¨Ì·Ó¤º®e¥O¦sÀɦW¡A¦ý¬O¸Ì­±¬O¨º­Ó¦³¨ç¼Æ¤½¦¡ªº¸Ü
¥L´N·|¶]¥X¥s§Ú¥t¦sªºµøµ¡­C¡C

P.S.§Ú¤w¸g§âIFS¨ç¼Æ§ï±¼¤F


§Ú¯à¸òÀs¤j½Ð±Ð»¡¡A§A¼gªº³o­Ó¨ç¼Æ·N«ä
¬O¥ý®Ú¾Ú§Úªº±ø¥ó¥ý¦æ²£¥Í¤@­ÓÀÉ®× ( xPH & "²Ä1~" & xWeek & "¶g.xlsx" )
¨Ã±q³o­ÓÀɮפÀ§O¥t¦s¥X¨Óªº¶Ü?
¦]¬°­n¬O³o¼Ëªº¸Ü¡A·Ó²z»¡¤£·|¥X²{¥s§Ú¥t¦s§a¡A¥Nªí¥L§ä¤£¨ì¸Ì­±ªº­È©O?


§Ú¦b·Q·Ó¥H¤Uªº¨BÆJ¹Á¸Õ¼gµ{¦¡½X¡A¦ýµM«á´N¥d¦í¤F(¦b¤£¥ý¦æ²£¥Í  xPH & "²Ä1~" & xWeek & "¶g.xlsx" ±¡ªp¤U)
°²³]§Ú¿é¤J3 ¡A
¥ý¦b­ì¥»ªºÀÉ®× ²£¥Í¤T­Ó¤u§@ªí¡A ²Ä¤@¶g¡B²Ä¤G¶g¡B²Ä¤T¶g
¤T­Ó¤u§@ªí¸Ì­±ªº­È¤]³£Âà´«¦¨¯Â¤å¦r¤F
¦b§å¶q¥t¦s¡A¨Ã¤À§O®Ú¾Ú­ì¥»Àɮתº ²Ä¤@¶g¡B²Ä¤G¶g¡B²Ä¤T¶gªºÀx¦s®æ §@¬°ÀɦW
¦b§R±¼­ì¥»ªºÀɮתº¤T­Ó¤u§@ªí¡C

Sub Create01() '§å¶q½Æ»s'

Dim xS As Worksheet, xName As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual          '°±¥Î¦Û°Ê­«ºâ
xPH$ = ThisWorkbook.Path & "\"

    Set xS = Sheets("¶g³øªí")
    xWeek% = InputBox("½Ð¿é¤J²Ä1¶g¡ã²Ä""?""¶g") 'Aµ²ªG¡G¤À§O²£¥Í5­ÓÀɮסC( ²Ä1¶g.XLSX ²Ä2¶g.XLSX  ²Ä3¶g.XLSX  ²Ä4¶g.XLSX  ²Ä5¶g.XLSX)

    For i = 1 To xWeek
   
        xS.Copy After:=Sheets(Sheets.Count)
        Set xName = ActiveSheet
        xName.Name = "²Ä" & i & "¶g"
        
        With xName.UsedRange
            .Calculate                        '­«ºâ
            .Value = .Value
        End With
        
        Strday = ActiveSheet.Range("F1")
        
        xName.Copy
        
        With ActiveWorkbook
            .SaveAs xPH & Strday & i & "¶g.xlsx", CreateBackup:=False
            .Close True
        End With
                     
        xName.Delete
   
        Set xName = Nothing
        
    Next
   
    Set xS = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic     '±Ò¥Î¦Û°Ê­«ºâ

End Sub

¶]³o¼ËÁÙ¬O¿ù

½Ð­ì½Ì¤p§Ìªº·MÄø
§Ú¯uªº¤£·|§â³o¦ê

With Workbooks.Open(xlsName)
  For sh = 1 To .Sheets.Count
    Strday = .Sheets(sh).[F1]                                             '§Aªº¤é´Á¶}©l¡A½Ð¦Û¦æ¥´¶}´ú¸Õ
    Endday = .Sheets(sh).[H1]                                             '§Aªº¤é´Áµ²§ô¡A½Ð¦Û¦æ¥´¶}´ú¸Õ
    xlsName = "(" & .Sheets(sh).Name & ").xlsx"
    xlsName = xPH & Strday & "~" & Endday & xlsName
   
    .Sheets(sh).Copy
    ActiveWorkbook.SaveAs xlsName
    ActiveWorkbook.Close True
  Next
  .Close False
End With

±a¤J¶i¥h....

¦A«ô°UÀs¤jÀ˵ø¤F

TEST-0630.zip (331.38 KB)

TOP

¦^´_ 18# n7822123

ÁÂÁÂÀs¤jªºÂI¿ô¡A­ì¨Ó¬O®æ¦¡°ÝÃD¡Aê©ó§Ú¦Û¤vªº»Ý¨D
§Ú¬O§Æ±æ¯à§e²{¥Á°ê¡A©Ò¥H§Ú¥t¥~³z¹L =TEXT(F1,"eemmdd") µ¥¤è¦¡
µM«á¦A§â¥L«ü©w¨ì¨ä¥LÀx¦s®æ´N¥i¥H¦¨¥\


      Strday = Format(Sheets(sh).[I1]
      Endday = Format(Sheets(sh).[K1]

¥Ø«e´N®t³Ì«á¤@¤j¨B¤F¡A¦]¬°§Ú¤£·Q­n¥ý²£¥Í Bµ²ªG  
©Ò¥H§ÚÁÙ¬O¹Á¸Õ§â¥L¼g¶i¥h


§Ú¦³´ú¸Õ§Ú¿é¤J3®É­Ô¡A¥L¥u·|²£¥Í ²Ä1¶g.xlsx  ²Ä2¶g.xlsx ©M¤@­Ó ~(¤u§@ªí1).xlsx

Sub test0630()

Dim xWeek As Integer
Dim xS As Worksheet
Dim xPH$


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual          '°±¥Î¦Û°Ê­«ºâ
  

xPH = ThisWorkbook.Path & "\"
On Error Resume Next
Set xS = Sheets("¶g³øªí")
xWeek = InputBox("½Ð¿é¤J²Ä""?""¶g")

With Workbooks.Add
  sh_Cnt = .Sheets.Count
  For sh = 1 To xWeek
  
    xS.Activate
    xS.Copy After:=Sheets(Sheets.Count)
    Set xName = ActiveSheet
    ActiveSheet.Name = "²Ä" & sh & "¶g"
   
        With xName.UsedRange
            .Calculate
            .Value = .Value
        End With
        
    xName.Copy After:=.Sheets(.Sheets.Count)
    xName.Delete

     Strday = Format(Sheets(sh).[I1])
      Endday = Format(Sheets(sh).[K1])
      
      xlsName = "(" & .Sheets(sh).Name & ").xlsx"          '½Ð°Ý¬°¤°»ò»Ý­n³o¦ê©O?
      xlsName = xPH & Strday & "~" & Endday & xlsName
      .Sheets(sh).Copy
   
    ActiveWorkbook.SaveAs xlsName
    ActiveWorkbook.Close True
   
  Next
  .Close False

  
End With

Set xS = Nothing
Set xName = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic     '±Ò¥Î¦Û°Ê­«ºâ
   
End Sub

¬°¤°»ò§Ú¤w¸g¿é¤J3 ·|¶]¤£¥X²Ä¤T¶g©O ¯u©_©Ç....

¦A³Â·ÐÀs¤j¬Ý¤@¤Uªþ¥ó

TEST0630_2.zip (335.56 KB)

TOP

¦^´_ 20# n7822123

¯uªº¤Ó·PÁ Às¤j ¤F!!!!!

¯uªº¤£¦n·N«ä¡A¥Ø«e¯à¤O«o¥u¯àªF´ê´ê¦è´ê´ê¡AÁÙ¦b§V¤O²z¸Ñ¦U­Óµ{¦¡½Xªº·N«ä...§V¤O¾Ç²ß¤¤!!

TOP

        ÀR«ä¦Û¦b : ¦³®É·í«äµL®É­W¡A¦n¤Ñ­n¿n«B¨Ó³¡C
ªð¦^¦Cªí ¤W¤@¥DÃD