jcchiang

¦^´_ 10# edmondsforum
for...nextÅܼƬOI,¤£¬OxWeek

With ActiveWorkbook
                            ActiveSheet.Name = "²Ä" & I & "¶g"
                            .SaveAs xPH & "²Ä" & I & "¶g.xlsx", CreateBackup:=False
                            .Close
                        End With

edmondsforum

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

n7822123

¦^´_ 10# edmondsforum


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

§ÚªºExcelª©¥»¬Oªº2007ª©¡A¨S¦³IFS¨ç¼Æ
©Ò¥H¤u§@¶i«×ªí®æªºG3Äæ¦ì§Ú¬Ý¨ìªº¬O¿ù»~­È
³s±a¼vÅT'¤u§@¶i«×'ªºF¾ãÄæ¡B'¶g³øªí'ªºF1¡BF1¡BH1¡BD4¡BD5¬Ý¨ìªº³£¬O¿ù»~­È
©Ò¥H³o³¡¤À§Ú¨S¿ìªkÀ°§AÀˬd¨ç¼Æªº¥¿½T©Ê

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

¦P¬°¤W­±°ÝÃD¡A¨S¦³IFS¨ç¼Æ¡A§Ú¬Ý¨ìªºF1»PH1¬O¿ù»~­È¡A
§Ú¦Û¤v¼g­Ó¤é´Á°Ï¶¡¡A§A¦A¦Û¤v§ï¦¨§A­nªºÀɦW

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§@ªí

³o³¡¤À¤w§¹¦¨¡A¨S¤°»ò°ÝÃD¡A¬°¤F¤è«K§A¾\Ū¡AAµ²ªG»PBµ²ªG§Ú¤À¬q¼g  



¥H¤U¬Oµ{¦¡³¡¤À

Sub test0624()
Dim xWeek As Integer
Dim xS As Worksheet
Dim xPH$
Dim ¦~¥÷ As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual          '°±¥Î¦Û°Ê­«ºâ  
¦~¥÷ = 2020     '§PÂ_¨C¶gªº°_©l¡B¨C¶gªºµ²§ô¤é´Á¥Î
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 = Format(¶g©l¤é(¦~¥÷, sh), "emmdd")              '§Q¥Î¦Û©w¨ç¼Æ§ì¸Ó¶g¦¸ªº°_¨Ï¤é´Á(ªüÀsTest¥Î)
    Endday = Format(¶g©l¤é(¦~¥÷, sh) + 6, "emmdd")     '§Q¥Î¦Û©w¨ç¼Æ§ì¸Ó¶g¦¸ªºµ²§ô¤é´Á(ªüÀsTest¥Î)
    '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¬q°Æ¨ç¼Æ¬O§Ú¦Û¤v©wªº¡A¦]¬°§Ú¬Ý¨ìªºF1¡BG1¬O¿ù»~­È¡A
©Ò¥H§A§âÀɦW§ï±¼¤§«á¡A³o¬q°Æ¨ç¼Æ¬å±¼¤]¨SÃö«Y

Function ¶g©l¤é(ByVal ¦è¤¸ As Integer, ByVal ¶g¦¸ As Integer) As Date
Dim Day1 As Date, ¶g©l1 As Date
Day1 = DateSerial(2020, 1, 1)
¶g©l1 = Day1 - Weekday(Day1) + 1
Dayadd = (¶g¦¸ - 1) * 7
¶g©l¤é = ¶g©l1 + Dayadd
End Function


Àɮצp¤U¡A¤è«Kª©Excelªº¤H¤]¥i¥H¥´¶}¨Ó¬Ý¡A§Ú¦s2­ÓÀÉ®×(·sª© & ª©)
©ú¤Ñ¤@¾ã¤Ñ­n¥X¥hª±¡A¦pªGÁÙ¦³¥ô¦ó°ÝÃD¡A¥u¯àµ¥¬Ý¬Ý¨ä¥L¤H¦^ÂФF¡A
§Ú³Ì§Ö6/26±ß¤W¤~¯à¦^ÂÐ


Test-0625.rar (424.62 KB)

¤U¸ü¦¸¼Æ: 6

2020-6-25 01:27

n7822123

¦^´_ 12# edmondsforum

¥Xªù«e¬Ý¤F¤@¤U¡A§A¦n¹³­n¤À¨â­Óµ{§Ç¡A¥Î¨â­Ó«ö¶s±±¨î

©Ò¥H§Ú§âµ{¦¡¤À¶}¦p¤U

²Ä¤@­Óµ{§Ç (²£¥Í¦h­ÓÀÉ®×)

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
    xName.Copy
    With ActiveWorkbook
        .SaveAs xPH & "²Ä" & 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


²Ä¤G­Óµ{§Ç (²£¥Í1­ÓÀɮסA¦h¤u§@ªí)

Sub Create02()   '¿W¥ß½Æ»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²Ä""?""¶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
        xName.Name = "²Ä" & sh & "¶g"
        With xName.UsedRange
            .Calculate       '­«ºâ
            .Value = .Value
        End With
        xName.Copy After:=.Sheets(.Sheets.Count)   'ª`Sheets«e­±¦³ "." ¬O½Æ»s¨ì·sªº¬¡­¶Ã¯
        xName.Delete
        Set xName = Nothing
    Next sh
    '§R°£­ì¥»ªÅ¥Õªí®æ
    For sh = 1 To sh_Cnt: .Sheets(1).Delete: Next
    '¦sÀÉÃö³¬
    .SaveAs xlsName
    .Close True
End With        
Set xS = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic     '±Ò¥Î¦Û°Ê­«ºâ
End Sub

§Aªº¤u§@ªí¨ç¼Æ¹Bºâ¶q¤Ó¤j........«Ü®e©ö¦º·í

©Ò¥H§Ú°õ¦æµ{¦¡¹Lµ{¤¤§â¨ç¼Æ¦Û°Ê­«ºâÃö³¬

«Øij§A½G¨­¤@¤U¡A´î¤Ö¨ç¼Æ­pºâ¶q

¥Xªù¤F¡AÙTÙT

­ã´£³¡ªL

Sub Âà¦s()
Dim xSht As Worksheet, xPH$, NN, SName$, i&
Set xSht = Sheets("¶g³øªí")
xPH = ThisWorkbook.Path & "\"
For i = 1 To 1 '1¦Ü²Ä?¶g, ¦Û¤v·d©w
    SName = "²Ä" & i & "¶g.xls"
    xSht.Copy
    With ActiveWorkbook
         With .Sheets(1).UsedRange: .Value = .Value: End With
         For Each NN In .Names '³Q±a¹L¨Óªº¤p«Ä--©w¸q¦WºÙ--§R°£
             If InStr(NN.Name, "Print_") = 0 Then NN.Delete '°£¤FPrint¬ÛÃöªº, ¾l§R°£
         Next
         .SaveAs Filename:=xPH & SName, CreateBackup:=False
         .Close 0
    End With
Next i
End Sub


=============================

edmondsforum

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

¤U¸ü¦¸¼Æ: 4

2020-6-30 01:08

n7822123

¦^´_ 16# edmondsforum


¦pªG¯Â¤å¦r¥i¥H¡A¤½¦¡¤£¦æ¡A¨º¦]¸Ó¬O¤Ö­ÓÄݩʦӤw

¦]¬°¹q¸£¤£ª¾¹D§A¬O­n¥Î ¤½¦¡ ·íÀɦW ÁÙ¬O ¤½¦¡ªº ­È ·íÀɦW

§ÚÁÙ¨S´ú¡A­nºÎ¤F¡A§AªºÀÉ®×¥ú¬O¶}°_¨Ó´N­n¦n¤[~

§Ú©ú¤Ñ§ä®É¶¡¸Õ¡A§A¤]¥i¥H¥ý´ú¬Ý¬Ý¡A¬O¤£¬O¦h­Ó".Value"

´N¨S°ÝÃD¤F¡Aµ{¦¡¦p¤U


Strday = .Sheets(sh).[F1].Value                                                '§Aªº¤é´Á¶}©l¡A½Ð¦Û¦æ¥´¶}´ú¸Õ
Endday = .Sheets(sh).[H1].Value                                             '§Aªº¤é´Áµ²§ô¡A½Ð¦Û¦æ¥´¶}´ú¸Õ

n7822123

¦^´_ 16# edmondsforum

­è­è´ú¤@¤U¡Aµo²{­ì¦]¤F~~

ÀɮצWºÙ¤£¯à¥]§t "/" ¦r¤¸¡A¦Ó§AªºF1¡BG1ªºÀx¦s®æ®æ¦¡ ¬O "e/m/d"

©Ò¥H­×§ï¤@¤U¿é¥XÀɦWªº¤é´Á®æ¦¡´N¨S°ÝÃD¤F~~(Àx¦s®æ®æ¦¡¤£¥Î§ï)

¸ò.Value¨SÃö«Y¡AªGµM¦³¨ÇªF¦èÁÙ¬O­nÀÉ®×´ú¤~ª¾¹D°ÝÃD!

¦pªG¬O¤§«eªºÀÉ®×F1¡BG1¦b§Ú¬Ý¨Ó¬O¿ù»~­È¡A¨º§Ú´N§ó¤£·|µo²{³o°ÝÃD¤F~~

©Ò¥H§A­Ìµo°Ý¤@©w­nªþ¤WÀɮתü~~¤£µM¦^µªªÌ´N¸ò½M¤lºN¶H¨S¨â¼Ë


Strday = Format(.Sheets(sh).[F1], "emmdd")          '§Aªº¤é´Á¶}©l [F1]
Endday = Format(.Sheets(sh).[H1], "emmdd")        '§Aªº¤é´Áµ²§ô [H1]


Test-0630.rar (253.47 KB)

¤U¸ü¦¸¼Æ: 3

2020-6-30 03:29

edmondsforum

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

¤U¸ü¦¸¼Æ: 6

2020-6-30 11:16

n7822123

¦^´_ 19# edmondsforum


­n§ïµ{¦¡­n¬Ý±oÀ´«e«áªºµ{¦¡¦A§ï............

µ{¦¡«e«á¬O¦³ÃöÁpªº¡A¦pªG¤£»Ý­nµ²ªGB

¤£¥Î¼g¨º»ò½ÆÂø¡Aª½±µ½Æ»s¤u§@ªí¥t¦s¬¡­¶Ã¯´N¦n¤F~

ª½±µÂ²¤Æµ{¦¡µ¹§A

Sub test0630_1()
Dim xWeek As Integer
Dim xPH$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual          '°±¥Î¦Û°Ê­«ºâ
xPH = ThisWorkbook.Path & "\"
xWeek = InputBox("½Ð¿é¤J²Ä""?""¶g")
  For sh = 1 To xWeek
    Sheets("¶g³øªí").Copy
    With ActiveSheet
      .Name = "²Ä" & sh & "¶g"
      Strday = Format(.[I1])
      Endday = Format(.[K1])
      With .UsedRange
          .Calculate
          .Value = .Value
      End With
      xlsName = xPH & Strday & "~" & Endday & "(" & .Name & ").xlsx"      '½Ð°Ý¬°¤°»ò»Ý­n³o¦ê©O? -§ì¤u§@ªí "(²ÄX¶g)" ·í°µÀɦW
      .Parent.SaveAs xlsName
      .Parent.Close True
    End With
  Next sh
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic     '±Ò¥Î¦Û°Ê­«ºâ
End Sub